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")