n'oublions pas que ce vénérable ancêtre de l'informatique a cette année 30 ans et je me devais de faire quelque chose pour lui...
le format amstrad est vraiment un casse tête.
l’écran a 200 lignes et suivant le mode graphique la largeur de celui ci est de 160/320/640 pixels
ce qui donne une ligne de 80 octets a chaque fois
en mémoire les lignes adjacentes sont espacées de non pas 80 octets mais de 2048 octets
pour couronner le tout les pixels sont entrelacés
en mode 0 (160x200x16 couleurs) 12121212 les bits 1 correspondent a un pixel les bits 2 au pixel adjacent
en fait 21212121 sur nos pc ( little endian / big endian)
en mode 1 (320x200x4 couleurs) 43214321 les bits 1 correspondent a un pixel les bits 2 au pixel adjacent les bits 3 au pixel adjacent etc...
en mode 2 c'est plus simple chaque pixel est représenté par un octet
87654321
a ce propos :
je suis obligé de passer par une conversion en chaine de caractères pour récupérer les bits nécessaire a chaque pixel
si quelqu'un a un truc plus optimisé je suis preneur
une image en mode 0 postée pour que vous pouviez tester
http://www.moonshade.org/pure/KRAUSCH.ECR
Code : Tout sélectionner
InitSprite()
InitMouse()
InitKeyboard()
Global win=OpenWindow(#PB_Any,0,0,800,600,"") ; CPC screen
OpenWindowedScreen(WindowID(win),0,16,640,400)
Declare getmem(ID)
Declare putmem(ID,mem)
Declare.i decode(cpc,mode) ; decode(adresse memoire de l'image brute , mode graphique de l'image)
;
file$="KRAUSCH.ECR" ; nom du fichier
size=FileSize(file$)
*mem=AllocateMemory(size)
rf=ReadFile(#PB_Any,file$)
If rf<>0
ReadData(rf,*mem,size)
CloseFile(rf)
EndIf;
pic=decode(*mem,0)
StartDrawing(ScreenOutput())
DrawImage(ImageID(pic),0,0,640,400)
StopDrawing()
FlipBuffers()
Repeat
ev=WaitWindowEvent()
Until ev=#PB_Event_CloseWindow
;
Procedure.i decode(cpc,mode) ; cpc = adresse memoire du fichier SCR brut, mode d'affichage
Select mode
Case 0
rezpix=2 ; pixels par octets
surface=CreateImage(#PB_Any,160,200,32)
Case 1
rezpix=4
surface=CreateImage(#PB_Any,320,200,32)
Case 2
rezpix=8
surface=CreateImage(#PB_Any,640,200,32)
EndSelect
Dim pen(16) ; crayons
Dim palette(26) ; palette de l'amstrad
;---------------------------------------detecte le format de pixels RGB ou BRG------------------------
StartDrawing(ImageOutput(surface))
rgbrg=DrawingBufferPixelFormat() % 32768
If DrawingBufferPixelFormat() > 32768
reverse = 1
Else
reverse = 0
EndIf
StopDrawing()
;---------------------------------------------palette en format rgb----------------------------------------------
RGB$="0000000000800000ff8000005000508000ffff0000ff0080ff00ff0080000080800080ff8080008080805050ffFF8000FF8080FF80FF00FF0000FF8000FFFF80FF0080FF8080FFFFFFFF00FFFF80FFFFFF" ; palette Amstrad
;---------------------------------------------lis la palette dans le tableau palette------------------------
For c=0 To 26 ; pour chaque couleur possible
Select rgbrg ; on selectionne le bon format
Case #PB_PixelFormat_32Bits_RGB ; RGB
palette(c)=RGB(Val("$"+Mid(RGB$,c*6+1,2)),Val("$"+Mid(RGB$,c*6+3,2)),Val("$"+Mid(RGB$,c*6+5,2))) ;RGB
Case #PB_PixelFormat_32Bits_BGR ;BGR
palette(c)=RGB(Val("$"+Mid(RGB$,c*6+5,2)),Val("$"+Mid(RGB$,c*6+3,2)),Val("$"+Mid(RGB$,c*6+1,2)));BRG
EndSelect
Next
;-----------------------------------------------------------------------------------------------------------
pen$="01242006260002081012141618220305"
For pen =0 To 15
pen(pen)=palette(Val(Mid(pen$,pen*2+1,2)))
Next
*surf_mem=getmem(surface)
iw=ImageWidth(surface)
ih=ImageHeight(surface)
y=0
For blocs=0 To 24 ; blocs de lignes
pos=128+blocs*$50 ; header amsdos = 128 bits
For yy=0 To 7 ; pour les 8 lignes du bloc courant
For x=0 To 79 ; on lis les 80 octets
o=PeekB(cpc+pos)&$ff ; non signés
For pix=0 To rezpix-1 ; decoupe l'octet suivant le nombre de pixels a lire
Select mode ; suivant le mode grraphique de l'image
Case 0 ; mode 0 160x200 16 couleurs : 2 pixels par octets ( 4 bit par pixel )
;c1=Val("%"+Mid(b$,7+pix,1)+Mid(b$,5+pix,1)+Mid(b$,3+pix,1)+Mid(b$,1+pix,1)) ; pixels courant ( interleaved)
Select pix
Case 0
c1=((o & %10000000 )>>7)+((o & %00100000 )>>4)+((o & %00001000 )>>1)+((o & %00000010 ))<<2
Case 1
c1=((o & %01000000)>>6)+((o & %00010000)>>3)+((o & %00000100))+((o & %00000001)<<3)
EndSelect
Case 1 ; mode 1 320x200 4 couleurs : 4 pixels par octets (2 bits par pixel)
Select pix
Case 0
c1=((o & %10000000)>>7+(o & %00001000)>>2)
Case 1
c1=((o & %01000000)>>6+(o & %00000100)>>1)
Case 2
c1=((o & %00100000)>>5+(o & %00000010))
Case 3
c1=(o & %00000001)<<1+(o & %00010000)>>4
EndSelect
Case 2 ; mode 2 640,200 2 couleurs : 8 pixels par octets (1 bit par pixel)
c1=(o & (128 >> pix))>>(7-pix)
EndSelect
If reverse=1 ; si le flag reverse est a un ( l'image tete en bas en memoire)
PokeL(*surf_mem+(((x*rezpix+pix)*4))+((ih-1-y)*iw*4),pen(c1)) ; pixel courant est ecrit suivant la couleur
Else
PokeL(*surf_mem+(((x*rezpix+pix)*4))+((y)*iw*4),pen(c1)) ; pixel courant est ecrit suivant la couleur
EndIf
Next
pos+1
Next
pos+$800-$50 ; on se positionne au debut de la ligne suivante en memoire
y+1
Next
Next
putmem(surface,*surf_mem)
ProcedureReturn surface
EndProcedure
Procedure getmem(ID) ; copie une image dans la memoire pour y effectuer des operations avec peek et poke :)
ImageID= ImageID(id)
Hdc = CreateCompatibleDC_ ( GetDC_ ( ImageID ))
If HDC
bmi.BITMAPINFO
bm.BITMAP
GetObject_ ( ImageID , SizeOf(BITMAP), @bm.BITMAP)
bmi\bmiHeader\biSize = SizeOf(BITMAPINFOHEADER)
bmi\bmiheader\biWidth = bm\bmWidth
bmi\bmiheader\biHeight = bm\bmHeight
bmi\bmiheader\biPlanes = 1
bmi\bmiheader\biBitCount = 32
bmi\bmiheader\biCompression = #BI_RGB
HList = AllocateMemory (bm\bmWidth*bm\bmHeight*4)
GetDIBits_ (hDC, ImageID ,0,bm\bmHeight,HList,bmi, #DIB_RGB_COLORS )
ProcedureReturn HList
EndIf
EndProcedure
Procedure putmem(id,mem) ;copie une zone memoire dans une image existante
ImageID= ImageID(id)
Hdc = CreateCompatibleDC_ ( GetDC_ ( ImageID ))
If HDC
bmi.BITMAPINFO
bm.BITMAP
GetObject_ ( ImageID , SizeOf(BITMAP), @bm.BITMAP)
bmi\bmiHeader\biSize = SizeOf(BITMAPINFOHEADER)
bmi\bmiheader\biWidth = bm\bmWidth
bmi\bmiheader\biHeight = bm\bmHeight
bmi\bmiheader\biPlanes = 1
bmi\bmiheader\biBitCount = 32
bmi\bmiheader\biCompression = #BI_RGB
SetDIBits_ (hDC, ImageID ,0,bm\bmHeight,mem,bmi, #DIB_RGB_COLORS )
EndIf
EndProcedure
