' ****************************************************************************
' **                 ROUTINE DE CHAMP D'ETOILES EN GFA BASIC                **
' **    CALCULS: CTS/NLC   AFFICHAGE ET OPTIMISATIONS: THYREX/NLC           **
' **                                                                        **
' ** Voici donc le listing illustrant l'article sur les champs d'etoiles en **
' **GFA basic. Si vous l'utilisez dans vos programmes, n'oubliez pas de dire**
' **                  merci a THYREX et CTS de NLC-TSB                      **
' **                                                                        **
' **          CE PROGRAMME DOIT ETRE COMPILE POUR TOURNER !!!!!!!           **
' ****************************************************************************
'
' N'oubliez pas de merger l'inline !!!
'
INLINE decal%,32
'
nombre%=100      ! nombre d'‚toiles
'                ! si vous changez ce nombre, changez la routine d'affichage
GOSUB init
GOSUB calc_stars
GOSUB calc_curve
GOSUB demo
'
> PROCEDURE init
  or%=XBIOS(2)               ! adresse ecran initiale
  xb%=XBIOS(2)               ! notre premier ecran
  '
  DIM x&(nombre%),y&(nombre%),z&(nombre%) ! tableau de valeurs al‚atoires
  '                                       ! voir + loin
  taille%=100*4*nombre%      ! on calcul la taille de notre buffer pour les
  '                          ! offset et decalage des etoile:2 octets=1 offset
  '                          !                            2 octets=le decalage
  fre%=FRE(0)                ! memoire d'origine
  RESERVE fre%-32256-taille% ! on se reserve de la place pour le 2Šme ecran
  '                          ! et pour notre buffer
  buffer%=MALLOC(taille%)    ! on alloue la memoire au buffer
  deuxieme_ecran%=MALLOC(32256) ! et celle de notre 2Šme ecran
  ecran2%=AND(ADD(deuxieme_ecran%,256),&HFFFFFF00) ! ca c'est pour les STF
  '
  CLS
  '
  BMOVE xb%,ecran2%,32000    ! on efface nos deux ecrans
  '
  super%=GEMDOS(32,L:0)      ! on passe en superviseur
  '
  FOR i%=0 TO 15
    SETCOLOR i%,0            ! on met toutes les couleurs a zero
  NEXT i%
RETURN
> PROCEDURE calc_stars
  FOR t&=0 TO nombre%-1         ! on prend des valeurs al‚atoires et on
    x&(t&)=RANDOM(100)-50       ! les mets dans notre tableau
    y&(t&)=RANDOM(80)-40
    z&(t&)=RANDOM(100)
  NEXT t&
RETURN
PROCEDURE calc_curve
  '
  ' ** voici le calcul des coordonnees des etoiles **
  '     on a 100 etapes et 'nombre%' etoiles par etapes
  '
  SETCOLOR 15,7
  pt%=buffer%
  FOR pos&=0 TO 99
    PRINT AT(1,1);pos&        ! on affiche la position pour patienter
    FOR star&=0 TO nombre%-1
      q=1-z&(star&)/100       ! voila l'effet de perspective on peut en modifer
      xx&=x&(star&)/q         ! la valeur pour avoir plus ou moins de profondeur
      yy&=y&(star&)/q
      ADD xx&,160
      ADD yy&,100
      IF xx&>319 OR xx&<0         ! ca c'est le 'clipping' en x
        CLR xx&
        CLR yy&
        adresse&=0
        dec&=0
        GOTO write
      ENDIF
      IF yy&>199 OR yy&<0         ! ca c'est le 'clipping' en y
        CLR xx&
        CLR yy&
        adresse&=0
        dec&=0
        GOTO write
      ENDIF
      '
      adrx&=AND(SHR(ROUND(xx&),1),65528)
      adry&=MUL(160,ROUND(yy&))
      adresse&=ADD(adrx&,adry&)
      dec&=CARD{decal%+((xx& AND &HF)*2)}   ! on prend le decalage dans l'inline
      '
      IF z&(star&)<50 AND z&(star&)>0          ! ca c'est pour le changement
        ADD adresse&,0                         ! de couleurs selon le z de
      ELSE IF z&(star&)>=50 AND z&(star&)<=99  ! l'etoile
        ADD adresse&,2
      ENDIF
      '
    write:
      '
      CARD{pt%}=adresse&    ! on ecrit l'offset dans notre buffer
      CARD{pt%+2}=dec&      ! et le decalage lui correspondant
      '
      ADD pt%,4                     ! on passe a la position suivante
      '
      INC z&(star&)
      IF z&(star&)>99               ! ca c'est le 'clipping' en z
        z&(star&)=0
      ENDIF
    NEXT star&
  NEXT pos&
  CLS
  SETCOLOR 15,0
RETURN
> PROCEDURE demo
  CLS
  '
  CARD{&HFFFF8240}=&H0      ! on installe les couleurs
  CARD{&HFFFF8242}=&H333
  CARD{&HFFFF8244}=&H777
  CARD{&HFFFF8246}=&H777
  .
  '
  pt%=buffer%                ! ca c'est notre pointeur dans le buffer
  '
  ' ******* MERGEZ ICI LE FICHIER OLDEBUT.LST *******
  '
  '
  DO
    .
    SWAP xb%,ecran2%
    ~XBIOS(5,L:xb%,L:ecran2%,-1)
    '
    CARD{&HFFFF8240}=&H0
    VSYNC
    CARD{&HFFFF8240}=&H5   !on affiche le temps machine
    '
    ' ******* MERGEZ ICI LE FICHIER EFF.LST *******
    '
    '
    ' ******* MERGEZ ICI LE FICHIER ADRESSE.LST *******
    '
    '
    ' ******* MERGEZ ICI LE FICHIER AFFICHE.LST *******
    '
    '
    ' ******* MERGEZ ICI LE FICHIER MAGIC.LST *******
    '
    '
    '
    ADD pt%,nombre%*4         ! on passe a la position suivante
    IF pt%>=buffer%+taille%
      pt%=buffer%           ! ca c'est pour le bouclage
    ENDIF
    '
  LOOP UNTIL PEEK(&HFFFC02)=57
  bye_bye
RETURN
> PROCEDURE bye_bye
  '
  '   **** on rend tous ce qu'on a pris *****
  '
  ~GEMDOS(32,L:super%)  ! user mode
  '
  OUT 4,8
  '
  VOID XBIOS(5,L:or%,L:or%,-1)
  '
  old_pal$=MKI$(&H777)+MKI$(&H700)+MKI$(&H70)+MKI$(&H770)+MKI$(&H7)+MKI$(&H707)+MKI$(&H77)+MKI$(&H555)+MKI$(&H333)+MKI$(&H733)+MKI$(&H373)+MKI$(&H773)+MKI$(&H337)+MKI$(&H737)+MKI$(377)+MKI$(&H0)
  VOID XBIOS(6,L:V:old_pal$)
  '
  CLS
  ~MFREE(deuxieme_ecran%)
  ~MFREE(buffer%)
  RESERVE fre%
  '
  EDIT
  '
RETURN