Загрузка BMP. Модуль на тест.

[ Новые сообщения · Участники · Правила форума · Поиск · RSS ]

Страница 1 из 1
1

Загрузка BMP. Модуль на тест.

DarkDemon

Дата: Воскресенье, 26.10.2025, 18:55 | Сообщение # 1

Генерал-майор

Группа: Друзья

Сообщений: 261

Репутация: -1

Статус: Offline

Собственно суть в названии темы. Задача была отвязаться от FB-шного загрузчика.
Этот модуль будет частью 2D\3D библиотеки, над которой сейчас работаю(простая замена GL2D).
Поэтому потестить надо перед тем как всё собирать воедино.
Тут не реализован только 15 битный формат и из 16 битных там только один - сейчас не посчитал это нужным.
Остальное есть, сжатие не поддерживается, переназначение каналов - поддерживается(но надо тестить,
чую где-то лажа). Формализовать пока некогда, всё фигарю очень быстро - лишь бы написать.
Рефакторить и вылизывать тоже буду потом. Модуль не для тюфиков, т.е. TakePix без клиппинга.
Сделать клиппинг это два JA на асме, мне не трудно - но не хочу, ибо оно нафиг не надо, когда
всё загружено правильно и считывается по пикселям корректно.

Код

'
'
'   [ BMModule.BAS ]
'
'   Модуль для загрузки BMP.
'   Не использует встроенный в FB функционал.
'   Работает только с форматами без сжатия.
'
'   > Quiet Snow <  2025
'   Совместимость: FBC 0.23.0
'                  FBC 1.10.1
'

NAMESPACE BMP

'    Тип заголовка *.BMP

TYPE BMFile   FIELD = 1
    BmID AS SHORT = 19778
    FileSize AS ULONG
    Reserved AS LONG
    BmOFFSET AS ULONG = 54
END TYPE

'    Старый заголовок( 40 байт )
TYPE BMHead   FIELD = 1
    HeadSize AS ULONG = 40
    BmpSizeX AS ULONG
    BmpSizeY AS ULONG
    BmSlices AS USHORT = 1
    BitDepth AS USHORT = 32
    Compress AS LONG
    DataSize AS ULONG
    BmHorRes AS ULONG
    BmVerRes AS ULONG
    UseColor AS ULONG
    SignColr AS ULONG
END TYPE

'    Новый заголовок( 56 байт )
TYPE BMHeadv5   FIELD = 1
    HeadSize AS ULONG = 40
    BmpSizeX AS ULONG
    BmpSizeY AS ULONG
    BmSlices AS USHORT = 1
    BitDepth AS USHORT = 32
    Compress AS LONG
    DataSize AS ULONG
    BmHorRes AS ULONG
    BmVerRes AS ULONG
    UseColor AS ULONG
    SignColr AS ULONG
    RedMask  AS ULONG
    GrnMask  AS ULONG
    BlueMask AS ULONG
    AlphMask AS ULONG
END TYPE

'    Дополненный новый заголовок (Не реализован)
'TYPE CIEXYZ   FIELD = 1
'   ciexyzX AS ULONG
'   ciexyzY AS ULONG
'   ciexyzZ AS ULONG
'END TYPE

'TYPE CIEXYZTRIPLE    FIELD = 1
'   ciexyzRed AS CIEXYZ
'   ciexyzGreen AS CIEXYZ
'   ciexyzBlue AS CIEXYZ
'END TYPE

'TYPE BMHeadv5Add
'   CSType   AS ULONG
'   bV5Endpoints AS CIEXYZTRIPLE
'   GammaRed AS ULONG
'   GammaGrn AS ULONG
'   GammaBlu AS ULONG
'   Intent   AS ULONG
'   PrflData AS ULONG
'   ProfSize AS ULONG
'   Reserved AS ULONG
'END TYPE

   '  Заголовки
DIM FHead AS BMFile, BMPHead AS BMHead
DIM BMPHeadv5 AS BMHeadv5

'    Прототипы

DECLARE SUB  Load  (FName AS STRING)
DECLARE SUB  Save  (FName AS STRING)
DECLARE SUB  TakePix (x AS INTEGER, y AS INTEGER)
DECLARE FUNCTION TakePointer () AS ANY PTR
DECLARE SUB  ClosePic ()

'    Массивы

   DIM RAWMem AS BYTE PTR                       '    Память под файл целиком
   DIM BMMem AS BYTE PTR, BMLoaded AS SHORT     '    Указатель на загр. BMP и флаг того, что он загружен

   DIM BMSzX AS LONG, BMSzY AS LONG             '    Размер изображения
   DIM SvBMF AS INTEGER                         '    Свободный дескриптор

   DIM YMuls() AS BYTE PTR                      '    Предрасчитанный адрес для GetPix

   DIM PixCV AS ULONG                           '    Полученный GetPix-ом пиксель цвета

   DIM PalR(255) AS ULONG                       '    Палитра для 256 цветного BMP
   DIM PalG(255) AS ULONG
   DIM PalB(255) AS ULONG
   DIM Cv256(255) AS ULONG                      '    Готовый цвет из палитры

'
'    Загрузка *.BMP*
'

SUB Load (FName AS STRING)

   DIM  xp  AS INTEGER, yp    AS INTEGER
   DIM  Adr AS BYTE PTR, Adr2 AS BYTE PTR, PalAdr AS BYTE PTR
   DIM  OneLine AS INTEGER, TwoLine AS INTEGER
   DIM  Cv  AS ULONG, RCmp AS UBYTE, GCmp AS UBYTE, BCmp AS UBYTE, ACmp AS UBYTE

   DIM CvZam(3) AS INTEGER
   DIM RPosit AS INTEGER, GPosit AS INTEGER, BPosit AS INTEGER, APosit AS INTEGER

   DIM  Plus   AS INTEGER

   DIM  BMFLn AS UINTEGER                        '  Длина файла
   DIM  MaxColors AS USHORT

  '   Если уже загружен, то освободим память
   IF BMLoaded THEN ClosePic ()

  '   Откроем файл
   SvBMF = FREEFILE
   IF OPEN(FName, FOR BINARY, ACCESS READ, AS #SvBMF) THEN EXIT SUB

  '   Получим длину файла
   BMFLn = LOF(SvBMF)
   IF BMFLn = 0 THEN CLOSE SvBMF : EXIT SUB      '  Если файл пуст - выход

   GET #SvBMF, , FHead                           '  Загрузим заголовок

   IF FHead.BmID <> 19778 THEN CLOSE SvBMF : EXIT SUB   '  Если это не BMP файл - выход

   GET #SvBMF, , BMPHead                         '  Следующий заголовок ( 40 байт )

   '  Если новый заголовок v5 - тогда читаем его
   IF BMPHead.HeadSize >= 56 THEN
     SEEK #SvBMF, SEEK(SvBMF) - 40
     GET #SvBMF, , BMPHeadv5
      BMPHead.HeadSize = BMPHeadv5.HeadSize
      BMPHead.BmpSizeX = BMPHeadv5.BmpSizeX
      BMPHead.BmpSizeY = BMPHeadv5.BmpSizeY
      BMPHead.BmSlices = BMPHeadv5.BmSlices
      BMPHead.BitDepth = BMPHeadv5.BitDepth
      BMPHead.Compress = BMPHeadv5.Compress
      BMPHead.DataSize = BMPHeadv5.DataSize
      BMPHead.BmHorRes = BMPHeadv5.BmHorRes
      BMPHead.BmVerRes = BMPHeadv5.BmVerRes
      BMPHead.UseColor = BMPHeadv5.UseColor
      BMPHead.SignColr = BMPHeadv5.SignColr

      '   Определяем позиции каналов по маскам каналов
      FOR i AS INTEGER = 0 TO 3
         IF ((BMPHeadv5.RedMask AND 255) = 255) THEN
           RPosit = i
         END IF
         BMPHeadv5.RedMask = BMPHeadv5.RedMask SHR 8
      NEXT

      FOR i AS INTEGER = 0 TO 3
         IF ((BMPHeadv5.GrnMask AND 255) = 255) THEN
           GPosit = i
         END IF
         BMPHeadv5.GrnMask = BMPHeadv5.GrnMask SHR 8
      NEXT

      FOR i AS INTEGER = 0 TO 3
         IF ((BMPHeadv5.BlueMask AND 255) = 255) THEN
           BPosit = i
         END IF
         BMPHeadv5.BlueMask = BMPHeadv5.BlueMask SHR 8
      NEXT

      FOR i AS INTEGER = 0 TO 3
         IF ((BMPHeadv5.AlphMask AND 255) = 255) THEN
           APosit = i
         END IF
         BMPHeadv5.AlphMask = BMPHeadv5.AlphMask SHR 8
      NEXT

   END IF

  '   Получим размерность картинки
   BMSzX = BMPHead.BmpSizeX:   BMSzY = BMPHead.BmpSizeY

  '   Если размеры изображения нулевые, значит не будем грузить
   IF (BMSzX = 0) OR (BMSzY = 0) THEN CLOSE SvBMF : EXIT SUB

       '  Переходим в начало файла
         SEEK #SvBMF, 1

       '  Заводим память
         RAWMem = ALLOCATE(BMFLn)

       '  Грузим весь файл в память
         GET #SvBMF, , *RAWMem, BMFLn

  '   Закроем файл т.к. уже загрузили его
   CLOSE #SvBMF

  '   Теперь нужно распарсить файл в памяти

  '   Посчитаем пропуск байт на строку
  Plus = BMSzX AND 3
  Adr = RAWMem + FHead.BmOFFSET' + 1

  '   Заводим память под 32 битное изображение
  BMMem  = ALLOCATE(BMSzX * BMSzY * 4)
  OneLine = BMSzX * 4
  TwoLine = OneLine SHL 1

  '   Перезаводим массив предрасчитанных Y для TakePix
  REDIM YMuls(BMSzY)
  '   Заполняем
  FOR yp = 0 TO BMSzY - 1
      YMuls(yp) = BMMem + (yp * OneLine)
  NEXT

  Adr2 = CINT(BMMem) + CINT(BMSzX * BMSzY * 4) - OneLine ' - 100

  ' __________________________________________
  '
  '     Обрабатываем согласно битности
  ' __________________________________________

   SELECT CASE  BMPHead.BitDepth

  '    8 БИТ
    CASE 8
    'PRINT "----------8 BIT------------"

    '   Сколько цветов в 256-цветной палитре
     MaxColors = BMPHead.UseColor
     IF BMPHead.SignColr > MaxColors THEN MaxColors = BMPHead.SignColr
     PalAdr =  RAWMem + BMPHead.HeadSize + 14

      FOR QPal AS INTEGER = 0 TO MaxColors       '  Читаем палитру
         PalB(QPal) = PEEK(UBYTE, PalAdr)
         PalG(QPal) = PEEK(UBYTE, PalAdr + 1)
         PalR(QPal) = PEEK(UBYTE, PalAdr + 2)
         Cv256(QPal) = RGB(PalR(QPal), PalG(QPal), PalB(QPal))
         PalAdr += 4
      NEXT

     '   Идём в цикле по Y
     FOR yp = 0 TO BMSzY - 1

        '   Идём в цикле по X
        FOR xp = 0 TO BMSzX - 1
           '  Считываем цвет
           Cv = PEEK(UBYTE, Adr)
           POKE ULONG, Adr2, Cv256(Cv)' SHL 5' OR &HFF000000
           Adr += 1
           Adr2 += 4
        NEXT
        Adr += Plus
        Adr2 -= TwoLine
     NEXT

  '   15 БИТ
    CASE 15
    PRINT "----------15 BIT------------"

  '   16 БИТ
    CASE 16

     FOR yp = 0 TO BMSzY - 1

        FOR xp = 0 TO BMSzX - 1
           #IFNDEF __FB_64BIT__
            ASM
               MOV ESI,                   [Adr]'   AX = 16 Bit Color   RRRRRGGG GGGBBBBB
               LODSW

               MOV EBX, EAX                    '   BX = AX         RRRRRGGG GGGBBBBB
               AND EAX, &B1111100000011111     '   EAX =           RRRRR000 000BBBBB
               SHL BX, 5                       '   EBX =           GGGGGGBB BBB00000
               SHL EAX, 8                      '   EAX =  RRRRR000 000BBBBB 00000000
               AND BX, &B1111110000000000      '   EBX =  00000000 GGGGGG00 00000000
               SHR AX, 5                       '   EAX =  RRRRR000 00000000 BBBBB000
               OR  EAX, EBX
               MOV DWORD PTR[Cv], EAX

            END ASM
           #ELSE
            ASM
               MOV RSI,                   [Adr]'   AX = 16 Bit Color   RRRRRGGG GGGBBBBB
               LODSW

               MOV EBX, EAX                    '   BX = AX         RRRRRGGG GGGBBBBB
               AND EAX, &B1111100000011111     '   EAX =           RRRRR000 000BBBBB
               SHL BX, 5                       '   EBX =           GGGGGGBB BBB00000
               SHL EAX, 8                      '   EAX =  RRRRR000 000BBBBB 00000000
               AND BX, &B1111110000000000      '   EBX =  00000000 GGGGGG00 00000000
               SHR AX, 5                       '   EAX =  RRRRR000 00000000 BBBBB000
               OR  EAX, EBX
               MOV DWORD PTR[Cv], EAX

            END ASM
           #ENDIF

           POKE ULONG, Adr2, Cv

           Adr += 2
           Adr2 += 4
        NEXT
        Adr += Plus
        Adr2 -= TwoLine
     NEXT

  '   24 БИТ
    CASE 24

     '   Идём в цикле по Y
     FOR yp = 0 TO BMSzY - 1

        '   Идём в цикле по X
        FOR xp = 0 TO BMSzX - 1
           '  Считываем цвет
           Cv = PEEK(ULONG, Adr) AND &H00FFFFFF
           POKE ULONG, Adr2, Cv OR &HFF000000
           Adr += 3
           Adr2 += 4
        NEXT
        Adr += Plus
        Adr2 -= TwoLine
     NEXT

  '   32 БИТ
    CASE 32

     IF BMPHead.HeadSize = 40 THEN

       '   Идём в цикле по Y
       FOR yp = 0 TO BMSzY - 1

          '   Идём в цикле по X
          FOR xp = 0 TO BMSzX - 1
             Cv = PEEK(ULONG, Adr)     '  Считываем цвет
             POKE ULONG, Adr2, Cv      '  В память его
             Adr += 4
             Adr2 += 4
          NEXT
          Adr += Plus
          Adr2 -= TwoLine
       NEXT

     ELSEIF BMPHead.HeadSize >= 56 THEN

       '   Идём в цикле по Y
       FOR yp = 0 TO BMSzY - 1

          '   Идём в цикле по X
          FOR xp = 0 TO BMSzX - 1

             '  Считываем компоненты
             RCmp = PEEK(UBYTE, Adr + RPosit)
             GCmp = PEEK(UBYTE, Adr + GPosit)
             BCmp = PEEK(UBYTE, Adr + BPosit)
             ACmp = PEEK(UBYTE, Adr + APosit)

             '  Складываем в память
             POKE ULONG, Adr2, RGBA(RCmp, GCmp, BCmp, ACmp)
             Adr += 4
             Adr2 += 4
          NEXT
          Adr += Plus
          Adr2 -= TwoLine
       NEXT

     END IF

   END SELECT
   BMLoaded = -1
   DEALLOCATE (RAWMem)
  ' __________________________________________
  '
  '     Конец обработки битностей
  ' __________________________________________

END SUB

'
'    Взять пиксель с загруженного в память *.BMP*
'

SUB TakePix (x AS INTEGER, y AS INTEGER)

    PixCV = PEEK (ULONG, (x SHL 2 + YMuls(y) ) )

END SUB

'
'    Получить указатель на пиксели картинки
'

FUNCTION TakePointer () AS ANY PTR

    TakePointer = BMMem

END FUNCTION

'
'   Выгрузить *.BMP* из памяти.
'

SUB ClosePic ()
    IF BMLoaded = 0 THEN EXIT SUB
    DEALLOCATE (BMMem)
    BMMem = 0
    BMLoaded = 0
END SUB

END NAMESPACE

haav

Дата: Воскресенье, 26.10.2025, 19:40 | Сообщение # 2

Генералиссимус

Группа: Администраторы

Сообщений: 1436

Репутация: 50

Статус: Offline

Быстро глянул код.

Если загружаются более одной картинки , что делать? Буфер у тебя один , значит всегда затирается последним загруженным. Я прав?

232 строка (warning при компиляции). Не критично конечно же.

251 строка: ошибка: Aborting due to runtime error 6 (out of bounds array access) at line 251

Вы сохраняете власть над людьми покуда оставляете им что-то…Отберите у человека все, и этот человек уже будет неподвластен вам…

DarkDemon

Дата: Воскресенье, 26.10.2025, 20:01 | Сообщение # 3

Генерал-майор

Группа: Друзья

Сообщений: 261

Репутация: -1

Статус: Offline

Цитата

Если загружаются более одной картинки , что делать? Буфер у тебя один , значит всегда затирается последним загруженным. Я прав?

Да, одно считал. Если загружаешь следующее, то загруженное утилизируется и загружается новое.
Т.е. слот всего один. Загрузил, пользуешься текущим, снова загрузил, снова пользуешься текущим.
Довольно удобный принцип. Но я понял к чему ты это спросил. Так вышло, что пару дней назад дописал
прослойку к FBSound-у на старый компиль 0.23.0, в принципе она пойдёт под любой компиль, просто
привязана к старому FBSound, так вот там организована списочная(через массивы) работа с группами
файлов, цель была сделать групповую организацию и основной функционал воспроизвести случайный
файл из группы без повторов(имхо для игрушек - маст хев). Эту штуку возможно тоже выложу.

Тут же всё иначе. Сделано чтобы максимально просто получить доступ к пикселям в памяти.
Ну мало ли, альфа канал нужен или часть картинки. Но я тебя понял и вероятно функционал будет расти,
но чуть позже. Сейчас главное выловить все самые жестокие баги)))

Код

251 строка: ошибка: Aborting due to runtime error 6 (out of bounds array access) at line 251

Ого, где-то у меня значит жопа. Буду тогда внимательно смотреть и проверять границы...
Блин вечно какая-то задница с этими указателями)))

А что за файл ты пробовал загрузить? 251 это загрузка палитры 8-ми битной картинки.

Добавлено (26.10.2025, 20:09)
---------------------------------------------
А понял, жопа не страшная. Это банальный бажок.
Надо делать до MaxColors - 1. Т.к. в качестве параметров в файле это значение считается от единицы(фактическое кол-во),
а я итерирую от нуля. Спасибо за тестинг. Быстро кодил - не заметил.

Добавлено (26.10.2025, 20:25)
---------------------------------------------
Варнинги сейчас тоже стараюсь убирать. Забавно, если CINT-ы убрать и варнинга нет. Ой намудрил, забыл уже
там по кастингам, опять твой учебник надо перечитывать...
В целом, хорошо, продуктивно.

Сообщение отредактировал DarkDemon - Воскресенье, 26.10.2025, 20:02

haav

Дата: Воскресенье, 26.10.2025, 20:29 | Сообщение # 4

Генералиссимус

Группа: Администраторы

Сообщений: 1436

Репутация: 50

Статус: Offline

Ты хоть пример какой сюда напиши для визуального восприятия. Ты ведь как-то тестировал.

DarkDemon

Дата: Воскресенье, 26.10.2025, 21:00 | Сообщение # 5

Генерал-майор

Группа: Друзья

Сообщений: 261

Репутация: -1

Статус: Offline

Тестирование было после модуля, но я его удалил. Ща заново напишу, 2 сек.

Код

  #INCLUDE "BMModule.BAS"

CONST GFX_NoSwch_NoFrm = 12

DECLARE FUNCTION GetDispDt LIB "user32" ALIAS "EnumDisplaySettingsA"  (BYVAL AS ANY PTR, BYVAL AS ULONG,  BYVAL AS ANY PTR) AS LONG

  TYPE MyTip FIELD = 1
    NoUse AS ZSTRING * 36
    dmSize AS USHORT = 156
    NoUse2 AS ZSTRING * 66
    BitsPerPix AS ULONG
    PixWidth AS ULONG
    PixHeight AS ULONG
    DisplayFlags AS ULONG
    DisplayFreq AS ULONG
    NoUse3 AS ZSTRING * 32
  END TYPE
  DIM QInf AS MyTip

  GetDispDt (0, &HFFFFFFFF, @QInf)     '  Текущие настройки монитора

  SCREENRES QInf.PixWidth, QInf.PixHeight, 32, 1, GFX_NoSwch_NoFrm


  BMP.Load "1.bmp"                     '  Указать имя BMP файла

  '  Вывод попиксельно
  FOR iy AS INTEGER = 0 TO BMP.BMSzY - 1
     FOR ix AS INTEGER = 0 TO BMP.BMSzX - 1
        BMP.TakePix (ix, iy)
        PSET (ix, iy), BMP.PixCV
  NEXT ix, iy

  SLEEP

zamabuvaraeu

Дата: Воскресенье, 26.10.2025, 22:11 | Сообщение # 6

Полковник

Группа: Друзья

Сообщений: 173

Репутация: 5

Статус: Offline

Попиксельно — это же очень медленно. Как сразу всю картину одним вызовом вывести?

DarkDemon

Дата: Воскресенье, 26.10.2025, 22:26 | Сообщение # 7

Генерал-майор

Группа: Друзья

Сообщений: 261

Репутация: -1

Статус: Offline

Цитата

Попиксельно — это же очень медленно. Как сразу всю картину одним вызовом вывести?

Основное назначение модуля:
1) Отвязаться от FbGfx в плане загрузки картинок. (мне это + на далёкое будущее)
2) Максимально упростить загрузку текстур для OpenGL. 2 функции (BMP.Load, BMP.TakePointer)
3) Предоставить простой доступ к пикселям по координатам. Возможно кто-то вообще захочет
загрузить пиксели в обычный 2-х мерный массив и поработать с ними.

Работать с точками, безусловно, медленно, однако загрузка с диска в разы более ресурсоёмкая операция,
на её фоне это мелочи.
Я бы рекомендовал вести обработку полинейно, взяв поинтеры строк через внутрянку модуля YMuls(y),
это даст обширные возможности встроенному оптимизатору FB(у меня флор маппер на табличных оптимизациях
выдавал под 1300 кадров, взаместо 300 без оптимизаций, можно смекнуть за профит).

Добавлено (26.10.2025, 22:56)
---------------------------------------------

Цитата

Как сразу всю картину одним вызовом вывести?

Для этого и пишется модуль на OpenGL, для полной отвязки от FBGfx. Там ещё дофига работы,
недели две возиться до первых прототипов(и то не факт). То что показывал видео, это 1ый модуль,
примерно на 1700 строк, там просто шерстил возможности(они такими же и останутся), там
не всё хорошо, а точнее много что хреново. Поэтому переписываю с переосмыслением.
Архитектурно то что есть сейчас - мне нравится главное не забросить и допилить эту штуку.
Целый месяц жёсткого кодинга сильно выматывает после многих лет не кодинга.

haav

Дата: Понедельник, 27.10.2025, 05:58 | Сообщение # 8

Генералиссимус

Группа: Администраторы

Сообщений: 1436

Репутация: 50

Статус: Offline

Попробуй загрузить битмап из архива. Мне кажется цвет фона не совпадает. Остальные битмапы вроде загружались без проблем. RLE конечно же не пробовал , раз оно не поддерживается.

Прикрепления: 1_bmp.zip (1.4 Kb)

DarkDemon

Дата: Понедельник, 27.10.2025, 10:54 | Сообщение # 9

Генерал-майор

Группа: Друзья

Сообщений: 261

Репутация: -1

Статус: Offline

Цитата

Вот таких тестовых битмап мне не хватало. Спасибо Стас. Отличный тестинг.

Проблема банальна, это 15 битка, которую как раз обошёл стороной. Видимо оно всегда засовывается в 16 бит,
но надо всё проверить.
Что требуется для этого модуля чтобы он более менее пахал:
- Пофиксить 16 бит загрузчик (исходя из масок каналов, там всего 3 варианта, но альфа не в счёт)
- Дописать 4 бит загрузчик.
- Посмотреть что там с RLE хотя бы на 8 битах.

Короче всё ясно, буду ковырять потихоньку.

Загрузка BMP. Модуль на тест.

Страница 1 из 1
1