lire une image au format AMSTRAD CPC

[Micheao]

Merci pour ton code Case , il y a 30 ans j'avais pas d'ordinateur , mais j’allai chez un ami qui possédait un Amstrad CPC 464 c'est là que j'ai connu Cauldron sorcery , etc ..

[Frenchy Pilou]

Celui-ci était très potager!
Highway Encounter

[Flype]

Salut, sympa comme code.

Petit souci pour moi, je suis sous Linux et ton decoder est prévu pour Windows.
J'ai essayé de reprendre ton code pour le rendre multi-plateforme mais je ne suis pas sûr du résultat.
Tu cherchais aussi une solution pour initialiser les pens et palette - sans chaine de caractères,
je propose par exemple de stocker les valeurs dans une DataSection, et d'utiliser Restore / Read.

Sinon, as-tu un lien vers plus d'images .ECR s'il te plait, je trouve rien sur internet ?
Et aussi un lien vers une doc du format d'encodage, idem, rien sur internet ?

Essai conversion multi-plateforme :

Code : Tout sélectionner

;==============================================================================
;== Amstrad CPC Image Decoder
;== Author: Case
;== Version 0.2, 2015-09-05
;==============================================================================

EnableExplicit

Enumeration CPC_Modes
  #CPC_MODE_0 ; Mode 0, 160x200x16, 2 pixels/byte, 4 bit/pixel
  #CPC_MODE_1 ; Mode 1, 320x200x04, 4 pixels/byte, 2 bit/pixel
  #CPC_MODE_2 ; Mode 2, 640x200x02, 8 pixels/byte, 1 bit/pixel
EndEnumeration

Procedure ReadFileToMemory(fileName.s)
  
  Protected id.i, size.i, *buf
  
  size = FileSize(fileName)
  If size > 0
    id = ReadFile(#PB_Any, fileName)
    If id
      *buf = AllocateMemory(size)
      If *buf
        ReadData(id, *buf, size)
      EndIf
      CloseFile(id)
    EndIf
  EndIf
  
  ProcedureReturn *buf
  
EndProcedure

Procedure CPC_LoadImage(fileName.s, mode.i)
  
  Protected a, b, c, d, x, y, w, h
  Protected *buf, img, blocs, pos, res
  Protected Dim pen(16), Dim palette(26)
  
  *buf = ReadFileToMemory(fileName)
  
  If *buf
    
    Restore CPC_Palette
    For a = 0 To 26
      Read.l palette(a)
    Next
    
    Restore CPC_Pen
    For a = 0 To 15
      Read.b b
      pen(a) = palette(b)
    Next
    
    Select mode
      Case 0: res = 2 : w = 160 : h = 200
      Case 1: res = 4 : w = 320 : h = 200
      Case 2: res = 8 : w = 640 : h = 200
    EndSelect
    
    img = CreateImage(#PB_Any, w, h)
    If img And StartDrawing(ImageOutput(img))
      For blocs = 0 To 24
        pos = 128 + blocs * 80
        For c = 0 To 7
          For x = 0 To 79
            b = PeekB(*buf + pos) & $FF
            For a = 0 To res - 1
              Select mode
                Case #CPC_MODE_0
                  Select a
                    Case 0: d = ((b & %10000000) >> 7) + ((b & %00100000) >> 4) + 
                                ((b & %00001000) >> 1) + ((b & %00000010) << 2)
                    Case 1: d = ((b & %01000000) >> 6) + ((b & %00010000) >> 3) + 
                                ((b & %00000100)     ) + ((b & %00000001) << 3)
                  EndSelect
                Case #CPC_MODE_1
                  Select a
                    Case 0: d = ((b & %10000000) >> 7) + ((b & %00001000) >> 2)
                    Case 1: d = ((b & %01000000) >> 6) + ((b & %00000100) >> 1)
                    Case 2: d = ((b & %00100000) >> 5) + ((b & %00000010)     )
                    Case 3: d = ((b & %00000001) << 1) + ((b & %00010000) >> 4)
                  EndSelect
                Case #CPC_MODE_2
                  d = ( b & ( 128 >> a ) ) >> ( 7 - a )
              EndSelect
              Box(x * res, y, res, 1, pen(d))
            Next
            pos + 1
          Next
          pos + $800 - 80
          y + 1
        Next
      Next
      StopDrawing()
    EndIf
    FreeMemory(*buf)
  EndIf
  
  ProcedureReturn img
  
EndProcedure

;==============================================================================
; Example d'utilisation
;==============================================================================

Define img = CPC_LoadImage("KRAUSCH.ECR", #CPC_MODE_0)

If img
  If OpenWindow(0, 100, 100, ImageWidth(img), ImageHeight(img), "Amstrad CPC")
    ImageGadget(0, 0, 0, ImageWidth(img), ImageHeight(img), ImageID(img))
    Repeat
    Until WaitWindowEvent() = #PB_Event_CloseWindow
  EndIf
EndIf

End

;==============================================================================
; CPC Pens and Palette
;==============================================================================

DataSection
  CPC_Pen:
  Data.b 01, 24, 20, 06, 26, 00, 02, 08
  Data.b 10, 12, 14, 16, 18, 22, 03, 05
  CPC_Palette:
  Data.l $000000, $800000, $FF0000
  Data.l $000080, $500050, $FF0080
  Data.l $0000FF, $8000FF, $FF00FF
  Data.l $008000, $808000, $FF8000
  Data.l $008080, $808080, $FF5050
  Data.l $0080FF, $8080FF, $FF80FF
  Data.l $00FF00, $80FF00, $FFFF00
  Data.l $00FF80, $80FF80, $FFFF80
  Data.l $00FFFF, $80FFFF, $FFFFFF
EndDataSection

;==============================================================================
; End of file
;==============================================================================

[Flype]

ah si, un début de piste :
http://www.cpcwiki.eu/index.php/AMSDOS_Header
http://www.cpcwiki.eu/index.php/CPC_Palette
http://www.cpcwiki.eu/index.php/Format: ... _structure

[case]

c'etait pas pour les couleurs que je cherchais une façon de faire sans string mais pour décoder les bits des pixels (finalement j'ai utilisé des shift >> et << mais c'est bien d'avoir amélioré pour les datas j'ai eu la flemme
pour les ecr c'est compliqué il n'y en a pas sur le net , en fait j'ai utilisé managedsk pour extraire des fichiers depuis des images disques cpc

pour le format d'encodage c'est le format d'affichage brut du cpc

excellente doc par ici http://cpcrulez.fr/coding_ANTIBUG-01-st ... _ecran.htm

[Flype]

Ah bah oui en effet, excellente doc

[Flype]

...

[Flype]

Est-ce que c'est çà le bon aspect de l'image KRAUSCH.ECR ?

[Flype]

à priori, ce serait plus comme çà (?)

[case]

c'est ca

[Flype]

Cool, donc il y a une méthode avec seulement deux For/Next pour convertir... attends voir...

Peux-tu me faire des images Mode 1 et Mode 2 ?

[Flype]

Code : Tout sélectionner

;==============================================================================
;== Amstrad CPC Image Decoder
;== Version 0.5, 2015-09-06
;== Author: Case, Flype
;==============================================================================

DeclareModule CPC
  Declare LoadSCR(fileName.s, mode.i)
EndDeclareModule

Module CPC
  
  Structure Longs
    l.Long[0]
  EndStructure
  
  Prototype Decode(*a, x, y, w)
  
  Procedure Decode0(*a, x, y, w)
    Protected b = PeekB(*a+((y&7)<<11)+(y>>3)*80+(x>>2))
    If (x&2)=0 : b>>1 : EndIf
    ProcedureReturn ((b&1)<<3)+((b>>2)&4)+((b>>1)&2)+((b>>6)&1)
  EndProcedure
  
  Procedure Decode1(*a, x, y, w)
    Protected b = PeekB(*a+((y&7)<<11)+(y>>3)*80+(x>>2))>>(~x&3)
    ProcedureReturn ((b>>3)&2)+(b&1)
  EndProcedure
  
  Procedure Decode2(*a, x, y, w)
    ProcedureReturn (PeekB(*a+((y&7)<<11)+(((y>>3)*w+x)>>3))>>(~x&7))&1
  EndProcedure
  
  Procedure Decode(mode.i, *a, *b.Longs, *c.Longs)
    Protected x, y, w, h, i, d.Decode
    Select mode
      Case 0: w = 320 : h = 200 : d = @Decode0()
      Case 1: w = 320 : h = 200 : d = @Decode1()
      Case 2: w = 640 : h = 200 : d = @Decode2()
    EndSelect
    i = CreateImage(#PB_Any, w, h)
    If i
      If StartDrawing(ImageOutput(i))
        For y = 0 To h - 1
          For x = 0 To w - 1
            Plot(x, y, *b\l[*c\l[d(*a, x, y, w)]\l]\l)
          Next
        Next
        StopDrawing()
      EndIf
    EndIf
    ProcedureReturn i
  EndProcedure
  
  Procedure LoadSCR(fileName.s, mode.i)
    Protected f, l, i, *m
    l = FileSize(fileName)
    If l > 0
      f = ReadFile(#PB_Any, fileName)
      If f
        *m = AllocateMemory(l)
        If *m
          If ReadData(f, *m, l)
            i = Decode(mode, *m + 128, ?CPC_Palette, ?CPC_Pen)
          EndIf
          FreeMemory(*m)
        EndIf
        CloseFile(f)
      EndIf
    EndIf
    ProcedureReturn i
  EndProcedure
  
  DataSection ;{
    CPC_Pen:
    Data.l 1, 24, 20, 6, 26, 0, 2, 8, 10, 12, 14, 16, 18, 22, 3, 5
    CPC_Palette:
    Data.l $0000,$800000,$FF0000,$0080,$800080,$FF0080,$00FF,$8000FF,$FF00FF
    Data.l $8000,$808000,$FF8000,$8080,$808080,$FF5050,$80FF,$8080FF,$FF80FF
    Data.l $FF00,$80FF00,$FFFF00,$FF80,$80FF80,$FFFF80,$FFFF,$80FFFF,$FFFFFF
  EndDataSection ;}
  
EndModule

;==============================================================================

Define file$ = "KRAUSCH.ECR"
Define image = CPC::LoadSCR(file$, 0)
If image
  Define w = ImageWidth(image) * 1
  Define h = ImageHeight(image) * 1
  ResizeImage(image, w, h, #PB_Image_Raw)
  If OpenWindow(0, 100, 100, w, h, file$)
    ImageGadget(0, 0, 0, w, h, ImageID(image))
    Repeat : Until WaitWindowEvent() = #PB_Event_CloseWindow
  EndIf
EndIf

;==============================================================================

[Micheao]

Celui-ci était très potager!
Highway Encounter

Merci pour cette imahe j'ai joué souvent à ce jeux chez un ami c"était en 1986