Avez-vous un code source de base

Avez-vous un code source de base que vous chargez avant de coder un jeu, une démo et/ou un utilitaire ?

[Vous devez être inscrit et connecté pour voir ce lien]

Code:


' ******************************************************************************
' *                                                                            *
' *                                                                            *
' *                                                                            *
' *                                                                            *
' *                                                                            *
' *                                                                            *
' *                                                                            *
' ******************************************************************************
'
CLS
OPTION BASE 0
'
' ----------------------- ‚cran physique
xb%=XBIOS(2)
' ----------------------- ‚cran logique
xb2%=XBIOS(3)
'
' ----------------------- Sauvegarde de la palette actuelle
super%=GEMDOS(&H20,L:0)
pal$=STRING$(32,0)
pal%=V:pal$
BMOVE &HFFFF8240,pal%,32
' FOR i%=0 TO 31
' pal$=pal$+CHR$(PEEK(&HFFFF8240+i%))
' NEXT i%
~GEMDOS(&H20,L:super%)
'
' ----------------------- pour palettes fadinf
DIM palfade$(16)
DIM palfade%(16)
INLINE paltofade%,32
FOR i%=0 TO 15
  palfade$(i%)=SPACE$(32)
  palfade%(i%)=V:palfade$(i%)
NEXT i%
'
' ----------------------- Sauvegarde + changement r‚solution si n‚cessaire
res_ecran%=XBIOS(4)
IF res_ecran%<>0              ! basse r‚solution
  ~XBIOS(5,L:-1,L:-1,0)
ENDIF
'
' ----------------------- SPACKER 3
INLINE sp3_unpack%,1602
DIM reg%(16)                  ! pour initialiser les registres
adr2$=SPACE$(32066)           ! on cr‚e un buffer pour d‚compression
adr2%=V:adr2$                 ! on fixe l'adresse du buffer
'                             ! NB la taille du buffer peut etre diff‚rente
'
' ------------------------- Player SND(H)
DIM r%(16)
INLINE sndhplay%,186
sndhtune%=MALLOC(62000)
' ------------------------- Addresse de la zik
r%(14)=sndhtune%
' ------------------------- Fr‚quence (vitesse)
r%(7)=50
'
' ------------------------- Double palettes
INLINE set_palettes%,456
' -------------------------------  ! … placer dans le programme
' reset_palettes%=set_palettes%+4  ! START double palettes
' ~C:set_palettes%(94,L:c1%,L:c0%) ! Envoie les 2 adresses palettes … la routine
' ~C:reset_palettes%()             ! STOP double palette
'
' ------------------------- Les ‚crans
ecr1$=STRING$(32000,CHR$(0))
ecr2$=ecr1$
ecr3$=ecr1$
ecr4$=ecr1$
ecr5$=ecr1$
c$=SPACE$(32)
'
ecr1%=V:ecr1$
ecr2%=V:ecr2$
c%=V:c$
'
' ------------------------- Ecrans d'intro et la zic
INLINE ecr3%,32000
INLINE zic1%,32000
'
@sous_interpreteur
'
HIDEM
@intro
'
'
' ------------------------- Remise en ordre avec retour au GEM
@fin
'
' =============================================================================
' =============================================================================
' =============================================================================
' ===                            LES PRECEDURES                             ===
' =============================================================================
' =============================================================================
' =============================================================================
'
PROCEDURE sous_interpreteur
  ' ----------------------- Ici on recharge les INLINES au d‚marage
  ' BLOAD "C:GFA_35_E\BASES\INTRO\2016PLUS.SHD",ecr3%
RETURN
'
PROCEDURE depack(origine%,taille_packee%)
  ' !!! Transmettre:
  '                  - origine% = adresse du fichier compress‚
  '                  - taille_packee% = taille du fichier compress‚
  '
  ' --------------------- d‚compression SPEEEDpacker 3
  '
  BMOVE origine%,adr2%,taille_packee%
  reg%(8)=adr2%
  RCALL sp3_unpack%,reg%()
  '
  ' le fichier depack‚ est stock‚ dans adr2
  '
RETURN
'
PROCEDURE music_on
  '
  ' --------------------- START musique SND
  '
  RCALL sndhplay%+28,r%()
RETURN
PROCEDURE music_off
  '
  ' --------------------- STOP musique SND
  '
  RCALL sndhplay%+28+4,r%()
RETURN
'
PROCEDURE calc_to_black(paltofade%)
  '
  ' --------------------- Calcule les palettes pour fading
  '
  BMOVE paltofade%,palfade%(0),32
  FOR col&=1 TO 15
    FOR adr%=0 TO 30 STEP 2
      brou%=palfade%(col&-1)+adr%
      val&=CARD{brou%} !{palfade%(col&-1)+adr%}
      r|=AND(SHR(val&,8),&HF)
      v|=AND(SHR(val&,4),&HF)
      b|=AND(val&,&HF)
      IF r|<>0              !&HF !15
        IF r|<8             !>7
          ADD r|,7          !SUB r|,7
        ELSE
          SUB r|,8          !ADD r|,8
        ENDIF
      ENDIF
      IF v|<>0              !&HF !15
        IF v|<8             !>7
          ADD v|,7          !SUB v|,7
        ELSE
          SUB v|,8          !ADD v|,8
        ENDIF
      ENDIF
      IF b|<>0              !&HF !15
        IF b|<8             !>7
          ADD b|,7          !SUB b|,7
        ELSE
          SUB b|,8          !ADD b|,8
        ENDIF
      ENDIF
      coul&=SHL(r|,8) OR SHL(v|,4) OR b|
      adr_dest%=palfade%(col&)+adr%
      CARD{adr_dest%}=coul& !SHL(r|,8) OR SHL(v|,4) OR b|
    NEXT adr%
  NEXT col&
RETURN
PROCEDURE fade_out(attend%)
  '
  ' --------------------- fading de la palette de couleurs vers le noir
  '
  FOR i%=0 TO 15
    ~XBIOS(6,L:palfade%(i%))
    t%=TIMER
    REPEAT
    UNTIL TIMER-t%=attend%
  NEXT i%
RETURN
PROCEDURE fade_in(attend%)
  '
  ' --------------------- fading du noir vers la palette de couleurs
  '
  FOR i%=15 DOWNTO 0
    ~XBIOS(6,L:palfade%(i%))
    t%=TIMER
    REPEAT
    UNTIL TIMER-t%=attend%
  NEXT i%
RETURN
'
PROCEDURE fin
  '
  ' --------------------- restauration des parametres de l'ecran
  '
  ' --------------------- vide l'‚cran
  CLS
  '
  ' --------------------- r‚tablit la r‚solution de d‚part
  IF XBIOS(4)<>res_ecran%
    VOID XBIOS(5,L:-1,L:-1,res_ecran%)
  ENDIF
  '
  ' --------------------- r‚tablit la palette de couleurs de d‚part
  ~XBIOS(6,L:pal%)
  '
  ' --------------------- lib‚re la zone m‚moire r‚serv‚e
  RESERVE
  '
RETURN
'
PROCEDURE sauve_pi1
  v$=CHR$(0)
  vide$=SPACE$(32066)
  FOR i=1 TO 40
    MID$(vide$,i,1)=v$
  NEXT i
  FOR i=32000 TO 32066
    MID$(vide$,i,1)=v$
  NEXT i
  FILESELECT "*.pi1","",nom$
  IF LEN(nom$)>3
    IF MID$(nom$,LEN(nom$)-2,3)<>"PI1" OR MID$(nom$,LEN(nom$)-2,3)<>"pi1"
      nom$=nom$+".PI1   "
    ENDIF
  ELSE
    nom$=nom$+".PI1"
  ENDIF
  OPEN "R",#2,nom$,32066
  FIELD #2,32066 AS vide$
  PUT #2,1
  CLOSE
  OPEN "A",#1,nom$
  SEEK #1,2
  c$=""
  FOR i%=0 TO 32
    c$=c$+CHR$(PEEK(&HFFFF8240+i%))
  NEXT i%
  BPUT #1,VARPTR(c$),32
  SEEK #1,34
  HIDEM
  BPUT #1,XBIOS(2),32000
  CLOSE
  SHOWM
RETURN



Que pensez-vous y ajouter ?

Une Procédure de Fading !!!!
Il faut que je teste ça

ça fonctionne de folie !

Ben oui, normal c'est une routine de Tomchi.

on peut l'utiliser ?

Certainement et même l'améliorer.
Si tu y apporte une quelconque amélioration n'oublie pas de partager dans ce poste.