Portable pixmaps and greymaps

Share your advanced PureBasic knowledge/code with the community.
Trond
Always Here
Always Here
Posts: 7446
Joined: Mon Sep 22, 2003 6:45 pm
Location: Norway

Portable pixmaps and greymaps

Post by Trond »

Portable pixmaps and greymaps (ppm and pgm) are some really simple format for storing pixel data. I made some functions to read and write these.

Edit: Fixed mixed up height and width in loading functions.

Code: Select all

; rgba.pbi
; RGBA structs

Structure SRGBA
  r.a
  g.a
  b.a
  a.a
EndStructure

Structure SRGBA_Long
  StructureUnion
    rgba.SRGBA
    xLong.l
  EndStructureUnion
EndStructure

Code: Select all

; ppm.pbi
; Handling of portable pixmaps and greymaps

XIncludeFile "rgba.pbi"

; Load portable greymap (0-255 per pixel)
Procedure LoadPGM(Array PGM(2), Filename.s)
  F = ReadFile(#PB_Any, Filename)
  If ReadString(F) <> "P5"
    ProcedureReturn 0
  EndIf
  ReadString(F) ; # comment
  HW.s = ReadString(F)
  ReadString(F) ; 255
  W = Val(HW)-1
  H = Val(StringField(HW, 2, " "))-1
  Dim PGM(W, H)
  
  For y = 0 To H
    For x = 0 To W
      PGM(x, y) = ReadAsciiCharacter(F)
    Next
  Next
  ProcedureReturn 1
EndProcedure

; Load portable pixmap (RGB)
Procedure LoadPPM(Array PPM(2), Filename.s)
  F = ReadFile(#PB_Any, Filename)
  If ReadString(F) <> "P6"
    ProcedureReturn 0
  EndIf
  ReadString(F) ; # comment
  HW.s = ReadString(F)
  ReadString(F) ; 255
  W = Val(HW)-1
  H = Val(StringField(HW, 2, " "))-1
  Dim PPM(W, H)
  
  For y = 0 To H
    For x = 0 To W
      C.SRGBA_Long
      C\rgba\r = ReadAsciiCharacter(F)
      C\rgba\g = ReadAsciiCharacter(F)
      C\rgba\b = ReadAsciiCharacter(F)
      PPM(x, y) = C\xLong
    Next
  Next
  ProcedureReturn 1
EndProcedure

; Save portable pixmap (RGB)
Procedure SavePPM(Array PPM(2), Filename.s)
  H = ArraySize(PPM(), 2)
  W = ArraySize(PPM(), 1)
  F = CreateFile(#PB_Any, Filename)
  WriteStringN(F, "P6")
  WriteStringN(F, "#")
  WriteStringN(F, Str(W+1) + " " + Str(H+1))
  WriteStringN(F, "255")
  
  For y = 0 To H
    For x = 0 To W
      C.SRGBA_Long\xlong = PPM(x, y)
      WriteAsciiCharacter(F, C\rgba\r)
      WriteAsciiCharacter(F, C\rgba\g)
      WriteAsciiCharacter(F, C\rgba\b)
    Next
  Next
EndProcedure

; Save portable greymap (0-255 per pixel)
Procedure SavePGM(Array PGM(2), Filename.s)
  H = ArraySize(PGM(), 2)
  W = ArraySize(PGM(), 1)
  F = CreateFile(#PB_Any, Filename)
  WriteStringN(F, "P5")
  WriteStringN(F, "#")
  WriteStringN(F, Str(W+1) + " " + Str(H+1))
  WriteStringN(F, "255")
  
  For y = 0 To H
    For x = 0 To W
      WriteAsciiCharacter(F, PGM(x, y))
    Next
  Next
EndProcedure

; Draw PPM onto PB image
Procedure DrawPPM(Xoff, Yoff, Array PPM(2))
  H = ArraySize(PPM(), 2)
  W = ArraySize(PPM(), 1)
  For X = 0 To W
    For Y = 0 To H
      Plot(X+Xoff, Y+Yoff, PPM(X, Y))
    Next
  Next
EndProcedure

; Convert a greymap into a grey-looking pixmap
; PPM() must be dimmed to the same size as PGM()!
; PPM() and PGM() can safely be the same array
Procedure PGM_To_PPM(Array PGM(2), Array PPM(2))
  H = ArraySize(PPM(), 2)
  W = ArraySize(PPM(), 1)
  For X = 0 To W
    For Y = 0 To H
      C.SRGBA_Long
      C\rgba\r = PGM(X, Y)
      C\rgba\g = PGM(X, Y)
      C\rgba\b = PGM(X, Y)
      PPM(X, Y) = C\xLong
    Next
  Next
EndProcedure

Code: Select all

; image viewer.pb
XIncludeFile "ppm.pbi"

Procedure LoadFile(F.s)
  Dim Pixmap(0, 0)
  Select GetExtensionPart(F)
    Case "pgm"
      If LoadPGM(Pixmap(), F)
        Loaded = 1
        PGM_To_PPM(Pixmap(), Pixmap())
      EndIf
    Default
      If LoadPPM(Pixmap(), F)
        Loaded = 1
      EndIf
  EndSelect
  If Loaded
    CreateImage(0, ArraySize(Pixmap(), 1)+1, ArraySize(Pixmap(), 2)+1)
    StartDrawing(ImageOutput(0))
      DrawPPM(0, 0, Pixmap())
    StopDrawing()
    SetGadgetState(3, ImageID(0))
    SetGadgetAttribute(2, #PB_ScrollArea_InnerWidth, ImageWidth(0))
    SetGadgetAttribute(2, #PB_ScrollArea_InnerHeight, ImageHeight(0))
    SetWindowTitle(0, GetFilePart(F))
    T.s = Str(ArraySize(Pixmap(), 1)+1) + "x" +Str(ArraySize(Pixmap(), 2)+1)
    SetGadgetText(1, T+ ": " + F)
  EndIf
EndProcedure

#W = 512
#H = 384

OpenWindow(0, 0, 0, #W, #H, "", #PB_Window_ScreenCentered | #PB_Window_SystemMenu | #PB_Window_SizeGadget | #PB_Window_MinimizeGadget | #PB_Window_MaximizeGadget)
ContainerGadget(0, 0, -2, 24, 24, #PB_Container_BorderLess)
CreateToolBar(0, GadgetID(0))
ToolBarStandardButton(0, #PB_ToolBarIcon_Open)
CloseGadgetList()
TextGadget(1, 32, 4, WindowWidth(0)-32, 20, "")
ScrollAreaGadget(2, 0, 24, WindowWidth(0), WindowHeight(0)-32, 100, 100, 30, #PB_ScrollArea_BorderLess | #PB_ScrollArea_Center)
ImageGadget(3, 0, 0, 10, 10, 0)

Repeat
  Select WaitWindowEvent()
    Case #PB_Event_Menu
      Select EventMenu()
        Case 0
          F.s = OpenFileRequester("", "", "Pixmaps (*.ppm;*.pgm)|*.ppm;*.pgm|All Files|*.*", 0)
          LoadFile(F)
      EndSelect
    Case #PB_Event_SizeWindow
      ResizeGadget(2, 0, GadgetY(2), WindowWidth(0), WindowHeight(0)-GadgetY(2))
    Case #PB_Event_CloseWindow
      Break
  EndSelect
ForEver

Code: Select all


; Convert png to a greymap for each channel and a pixmap with all channels

XIncludeFile "rgba.pbi"
XIncludeFile "ppm.pbi"
UsePNGImageDecoder()

Base.s = "c:\i\"
F.s = Base + "sailboat.png"

LoadImage(0, F)

xM = ImageWidth(0)-1
yM = ImageHeight(0)-1

Dim R(xM, yM)
Dim G(xM, yM)
Dim B(xM, yM)
Dim Pic(xM, yM)

StartDrawing(ImageOutput(0))
  For x = 0 To xM
    For y = 0 To yM
      c = Point(x, y)
      R(x, y) = Red(c)
      G(x, y) = Green(c)
      B(x, y) = Blue(c)
      Pic(x, y) = c
    Next
  Next
StopDrawing()

SavePGM(R(), F+"_red.pgm")
SavePGM(G(), F+"_green.pgm")
SavePGM(B(), F+"_blue.pgm")

SavePPM(Pic(), F+".ppm")