32000

Aller en bas

32000

Message par Shadow272 le Sam 27 Jan - 8:36

32000 Un chti utilitaire qui permet de prendre une image DEGAS et d'en extraire les 32000 octets (images réelle) ainsi que les 32 octets de la palette des couleurs et d'en faire deux fichiers distincts, ou de la reconstituer à partir des 2 fichiers précédemment extraits.

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

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

Pourquoi me direz-vous ?
Dans nos programmes et plus particulièrement nos jeux il est fréquent d'utiliser plusieurs images ayant la même palette de couleurs, images de décor, sprites, . . .
En passant par cet utilitaire on, gagne 34 octets à chaque écran.

Code:

' ****************************************************************************
' *                                                                          *
' *                                                                          *
' *                                   32.000                                 *
' *           extrait les 32000 octets d'un ‚cran basse r‚solution           *
' *          et les 32 octets (registre couleurs) d'une Image DEGAS          *
' *            ou recr‚e cette image avec les 2 fichiers extraits            *
' *                                                                          *
' *                                                                          *
' ****************************************************************************
'
CLS
xb%=XBIOS(2)
'
' --------------------------------------sauvegarde de la palette
'
pal$=""
FOR i%=0 TO 31
  pal$=pal$+CHR$(PEEK(&HFFFF8240+i%))
NEXT i%
'
xb%=XBIOS(2)
xb2%=XBIOS(3)
'
' -------------------------Sauvegarde + changement r‚solution si n‚cessaire
res_ecran%=XBIOS(4)
'
image_pi1$=STRING$(32066,0)
image$=STRING$(32000,0)
c$=STRING$(32,0)
image_pi1%=V:image_pi1$
image%=V:image$
c%=V:c$
'
DO
  CLS
  PRINT AT(2,8);"1 Extraire les 2 fichierrs d'une PI1"
  PRINT AT(2,12);"2 Refaire une PI1 avec les 2 fichiers"
  PRINT AT(2,16);"3 ou Esc pour quitter"
  DO
    a%=INP(2)
    EXIT IF a%=49 OR a%=50 OR a%=51 OR a%=27
  LOOP
  '
  ' 27=Esc 49=1  50=2 51=3
  '
  IF a%=27 OR a%=51
    ' ------------------------------restauration des parametres de l'ecran
    '
    CLS
    '
    IF XBIOS(4)<>res_ecran%
      VOID XBIOS(5,L:-1,L:-1,res_ecran%)
    ENDIF
    '
    '
    ~XBIOS(6,L:(V:pal$))
    END
  ENDIF
  '
  IF a%=49
    @pi1_fichiers
  ENDIF
  IF a%=50
    @fichiers_pi1
  ENDIF
LOOP
'
'
PROCEDURE pi1_fichiers
  DO
    fichier$="\*.PI?"
    '
    FILESELECT fichier$,"",img$
    EXIT IF img$=""
    '
    l|=LEN(img$)
    FOR i%=l| TO 1 STEP -1
      IF MID$(img$,i%,1)="\"
        fichier$=MID$(img$,1,i%)
        i%=1
      ENDIF
    NEXT i%
    fichier$=fichier$+"*.PI1"
    '
    img2$=MID$(img$,1,(LEN(img$)-3))
    img3$=img2$+"CLR"
    img2$=img2$+"INL"
    OPEN "i",#1,img$
    '
    SEEK #1,2
    BGET #1,c%,32
    ~XBIOS(6,L:c%,32)
    SEEK #1,34
    BGET #1,xb%,32000
    CLOSE #1
    PAUSE 100
    HIDEM
    ALERT 2,"Sauver en INL",1,"-OUI-|-NON-",rep|
    IF rep|=1
      HIDEM
      BSAVE img2$,xb%,32000
      SHOWM
      ALERT 2,"Sauver le registre couleurs|    en CLR",1,"-OUI-|-NON-",rep2|
      IF rep2|=1
        BSAVE img3$,c%,32
      ENDIF
    ENDIF
    SHOWM
  LOOP
RETURN
'
PROCEDURE fichiers_pi1
  DO
    '
    ' --------------------------------- on vide les buffers
    image_pi1$=STRING$(32066,0)
    image$=STRING$(32000,0)
    c$=STRING$(32,0)
    image_pi1%=V:image_pi1$
    image%=V:image$
    c%=V:c$
    '
    fichier$="*.INL"
    '
    ' --------------------------------- on cherche le INLINE ‚cran 32000 octets
    FILESELECT fichier$,"",img$
    EXIT IF img$=""
    '
    l|=LEN(img$)
    FOR i%=l| TO 1 STEP -1
      IF MID$(img$,i%,1)="\"
        fichier$=MID$(img$,1,i%)
        i%=1
      ENDIF
    NEXT i%
    fichier$=fichier$+"*.PI1"
    '
    img2$=MID$(img$,1,(LEN(img$)-3))
    img3$=img2$+"CLR"
    img2$=img2$+"PI1"
    '
    OPEN "i",#1,img3$
    BGET #1,c%,32
    ~XBIOS(6,L:c%,32)
    CLOSE
    '
    OPEN "i",#1,img$
    BGET #1,xb%,32000
    CLOSE #1
    PAUSE 100
    HIDEM
    ALERT 2,"Sauver en PI1-2-3",1,"-OUI-|-NON-",rep|
    IF rep|=1
      ' ------------------------- Sauve DEGAS
      HIDEM
      BMOVE xb%,image_pi1%+34,32000
      BMOVE c%,image_pi1%+2,32
      CLOSE #1
      OPEN "O",#1,img2$
      BPUT #1,image_pi1%,32066
      CLOSE #1
      SHOWM
    ENDIF
    SHOWM
  LOOP
RETURN

Si vous ne voulez pas taper le code tout se trouve [Vous devez être inscrit et connecté pour voir ce lien].
avatar
Shadow272
Admin

Messages : 84
Date d'inscription : 28/12/2017
Age : 59
Localisation : Hainaut Belgique

Voir le profil de l'utilisateur http://toutatari.blog4ever.xyz/

Revenir en haut Aller en bas

Revenir en haut


 
Permission de ce forum:
Vous ne pouvez pas répondre aux sujets dans ce forum