PC-01 Lviv

Когда быстродействия явно не будет хватать, будем за каждый лишний байт хвататься!
Поэтому делай так, чтобы каждый момент кода в любой процедуре можно было заменить на АСМвставку!

  LOOP
    keys := Ctrl.Get();
    IF (Ctrl.Right IN keys) & (x < 51) THEN INC(x) END;
    IF (Ctrl.Left IN keys ) & (x >  0) THEN DEC(x) END;
    IF (Ctrl.Up IN keys   ) & (y >  0) THEN DEC(y) END;
    IF (Ctrl.Down IN keys ) & (y < 31) THEN INC(y) END;
    (* Lvov.FIL_BOX(x, y, x+5, y+5, 3); *)
    Gr.DrawTile(x, y, 8000H-1);
    RK86.WAIT(5000);
  END;

{BEGIN}
LabelA(StartProgram0);
Call(L8009); //SetTable;
Call(L8057);

MviA($01);Sta(X);//   x := 1;
LxiHL($0001);MovAL;Sta(Y);//y := 1;

LabelA(LOOP1);//   LOOP
//Call(Ctrl_Get);//MovAL;//Sta(Keys);//	    keys := Ctrl.Get();

MviA($F7);Out_($D2);In_($D2);cma;Ani($F0);

{Down IN keys}
   Cpi($80);Jm(gKeyD_m1);  Lda(Y); Cpi(31);JP(gKeyD_m4);  InrA;Sta(Y);JMP(gKeyD_m4);

{Left IN keys}
LabelA(gKeyD_m1);  Cpi($40);Jm(gKeyD_m2);  Lda(X); Cpi(1);Jm(gKeyD_m4);
DcrA;Sta(X);JMP(gKeyD_m4);

{Up IN keys}
LabelA(gKeyD_m2); Cpi($20);Jm(gKeyD_m3);  Lda(Y); Cpi(1);Jm(gKeyD_m4);
DcrA;Sta(Y);JMP(gKeyD_m4);

{Right IN keys}
LabelA(gKeyD_m3);Cpi($10);Jm(gKeyD_m4); Lda(X); Cpi(51);JP(gKeyD_m4);
InrA;Sta(X);JMP(gKeyD_m4);

LabelA(gKeyD_m4);

LabelA(L818A); // Gr.DrawTile(x, y, 8000H-1);
Lda(X);Sta(L8027);   Lda(Y);Sta(L8028);   LxiHL($7FFF);  Call(Gr_DrawTile);

LxiHL($1388);Call(L81A9); //    RK86.WAIT(5000);
JMP(LOOP1);

насчёт скрола.
Слушай, это мне надо подготавливать свой P_EMUL достаточно основательно.
Далее писать там пробы потом только на мадл перекидывать и компилировать.
Короче, варианта ДВА.
1. Отфутболь пока его и жди пока я это все проверну, чёрт знает сколько дней!
2. Знаешь как быстро написать его сам на обероне, - ну напиши!

Слушай, это ж был просто тестовый код! Зачем ты его переписываешь на асм?

Насчёт скролла понял. Попробую написать. Процедура будет брать адрес экрана по Y из таблички (это уже готово, кроме расчёта самой таблички - вот его точно надо на асм).

Высоту тайлов сделаем или 12, как ты и предложил, или 14. Что скажешь? Непарную (типа 13) делать нельзя, потому что тогда не будет полутайловой позиции.

Скорость на глазок получается весьма недурная. Когда сделаю вывод тайлов в полупозиции с битовыми сдвигами - отпишусь. Пока пришла мысль хранить два набора тайлов - обычный и сдвинутый на 2 пикселя (на полубайт). И при выводе каждой строки (4 байта) левый байт накладывать, потом выводить два следующих, и накладывать правый. Я такой вывод уже делал, правда, не для Львова, а для DOS/CGA.

Когда будет готов скролл и вывод тайла - тогда будем уже запускать игровой процесс. Ещё у нас есть процедура постепенного гашения экрана. Я так смотрю, что её можно будет взять из Мутельской версии (для Спека пришлось похачить). Погляди, может перепишешь для Львова.

static void lmove (unsigned to, unsigned from)
/*Пересылка (копирование) линии from в to*/
{{
 struct line {char __[80];};
 struct line _es * Lto;
 struct line _es * Lfrom;

 if (to == from || !(to < 192 && from < 192))
  return;
 _ES = seg;
 to += 4;
 from += 4;
 Lto = (struct line _es *)((to >> 1) * 80 + ((to & 1) << 13));
 Lfrom = (struct line _es *)((from >> 1) * 80 + ((from & 1) << 13));
 *Lto = *Lfrom;
}}

static void lclr (unsigned line)
/*Очистка линии экрана с данным номером*/
{{
 unsigned e = line;
 long _es* L;

 if (e < 192) {
  e += 4;
  _ES = seg;
  L = (long _es*)((e >> 1) * 80 + ((e & 1) << 13));
  for (e = 20; e; e--)
   *L ++ = 0;
   }
}}

void cls (void)
{{
 unsigned char _es* i;
 unsigned j;

 _ES = seg;
 i = 0;
 for (j = 17; j; j--) {
  run_delay (1);
  while ((unsigned)i < 16384)
   *i = 0, i += 17;
  i = (unsigned char _es*)(0x3FFF & (unsigned)i);
  wait_delay ();
   }
 ttyx = ttyy = 0;
}}

void scroll (signed lines)
/* +UP, -DOWN */
{{
 unsigned media, line;

 if (lines == 0)
  return;
 if (abs (lines) >= 192) {
  cls ();
  return;
   }
 if (lines > 0) {
  media = 192 - lines;
  for (line = 0; line < media; line ++)
   lmove (line, line + lines);
  while (line < 192)
   lclr (line ++);
   }
 else {
  media = -lines;
  for (line = 191; line >= media; line --)
   lmove (line, line + lines);
  while (line < 192)
   lclr (line --);
   }
}}

Что за табличка такая, кинь гляну!
ну по тому какою делать высоту, 12 или 14 я думаю смотри сам, как оно там чтобы "хорошо скелеилось" на какой именно высоте. Главное то ведь ширина кратная 4.
Та на пробах разных оно всегда так, - недурная! А вот когда "посыпяться алмазы" по всему экрану, вот тогда и покажет насколько недурная. Добро. ну если так эффективнее да и не влом...
Та я то погляжу! Но ведь "Лабиринт" видел, и ты должен понимать, что каких-то сложных понтов, таких как скролинг и плавные гашения экрана я не задействовал! Поэтому, помочь тебе уже я вряд ли чем смогу особенно со всякими навороченными понтами!
Да и моя логика, по другому б работала в данной ситуации, - если бы написал игру для одной платформы да еще и с понтами, то перекидывая на другую НЕИЗВЕСТНУЮ МНЕ ПЛАТФОРМУ, я просто бы откинул все понты (скролы, плавное гашение) тем более если платформа "заведомо" слабее! ну это конечно твоё дело... маслом кашу не испортишь! Т.е. красивыми понтами игрушку тоже! Вот правда сам понимаешь, что ценить то её будут не за понты, а за сам движок игры! Т.е. насколько приятно в неё играть будет! Мне например в собственный "Лабиринт" понравилось играть, сам не ожидал! Думал, что пока напишу, - хрен я в него играть буду с удовольствием! но играл всё таки!

Ну как говориться успехов! пише если вдруг чего!

Ну и если продвижением игрушки у тебя не закончится связываться со ПК-01 то еще поговорить бы надо об P_EMUL и XDev. В общем я тему по P_EMUL2021 опубликую там почитаешь, если не все, то хотя бы с "Оберон и XDev." до конца. ну и там же и коммент оставь свой!

Доп.
Ну вот создал тему
P_EMUL2021
viewtopic.php?f=8&t=400
глянь под настроение.

вообще насчёт XDev, есть надежды, что когда он будет полностью готов, его можно будет попробовать использовать! Ведь те проблемы, что у меня начались, то скорее всего после обновлений! И уж не важно, моя ли в том вина, но я решил, что если уж его использовать, то один раз установив и не "брыкаясь" со всяким обновлениями! Ведь ты же не будеш его до бесконечности дорабатывать по теме ПК-01 ?! ну вот окончательно готовое попробую!
Далее попробую P_EMUL2021 под него подогнать, вот тогда это всё "в куче" (P_EMUL2021+XDev) для меня лично действительно будет нечто!
Но мне нужна твоя помощь в том, чтобы сделать полную как можно точную аналогию ВСЕХ доступных процедур ПК-01 в XDev.
И обязательно сделай возможность асм вставок! В любом виде!
Хоть в таком

MODULE AsmTest; (*$MAIN*) IMPORT SYSTEM;

PROCEDURE Border (color: SYSTEM.BYTE);
BEGIN (*@
  #asm
        POP  DE           ; Снимаем адрес возврата
        POP  HL           ; Параметр color (он двухбайтовый, так решил zcc)
        PUSH HL           ; Возвращаем color обратно
        PUSH DE           ; Адрес возврата обратно
        LD   A, L         ; Вот это color, он в младшем байте. LD это аналог MOV (и MVI тоже)
        LD   (0xBE38), A  ; BORDER
        CALL 0xF836       ; CLS
  #endasm
*)
END Border;

BEGIN
  Border(25);
  LOOP END
END AsmTest.

Хоть в таком...

MODULE TestCalc;
IMPORT b := Basic, c := CalcZX;

BEGIN (*$MAIN*)
  b.Init;
  c.PushWord(1000); (* 1000 *)
  c.PushByte(24);   (*   24 *)
  c.Begin;
  c.add;            (*    + *)
  c.pi_div_2;       (* PI/2 *)
  c.duplicate;      (*  DUP *)
  c.add;            (*    + *)
  c.add;            (*    + *)
  c.End;
  b.PRSTR("1000 + 24 + PI = ");
  c.Print_PopReal();
  b.Quit
END TestCalc.

Ну такой вроде был уже (вверху)

PROCEDURE Border (color: SYSTEM.BYTE);
BEGIN @
  #asm
        POP  HL
        EX   (SP), HL
        LD   A, L
        LD   (0xBE38), A  ; BORDER
        CALL 0xF836       ; CLS
  #endasm
END Border;

и такой вполне годится

MODULE AsmTest;
IMPORT Asm;

PROCEDURE Border (color: INT8);
BEGIN
  Asm.Code("POP  BC    ");
  Asm.Code("POP  DE    ");
  Asm.Code("POP  HL    ");
  Asm.Code("PUSH HL    ");
  Asm.Code("PUSH DE    ");
  Asm.Code("PUSH BC    ");
  Asm.Code("LD   A,L   ");
  Asm.Code("CALL 0x229B");
END Border;

BEGIN (*$MAIN*)
  Border(2);
END AsmTest.

Главное чтобы было понятно как это можна использовать! А в такой штуковине как P_EMUL2021, я (и любой другой) "подточит" для себе как захочет!

Не "замыкай" возможности своей XDev на том, что только в ней!
Дай людям возможность использовать так как они хотят!
Например настроив P_EMUL2021!

Доп. слушай, начал смотреть...
я ведь си не знаю и для меня это какие-то "каракули"...
" if (to == from || !(to < 192 && from < 192))"
эти всякие "==" и "||" и "&&" да вся конструкция от паскаля явно отличается.
далее приколы...
" to += 4;"
" from += 4;"
?

"((to >> 1)"
?

" for (e = 20; e; e--)"
?

блин...
та всё там чёрт поймёш!

По поводу асм-вставок - это давно было можно, притом разными способами. И вот так тоже:

PROCEDURE Border (color: SYSTEM.BYTE);
BEGIN (*@
  #asm
...
  #endasm
*)
END Border;

Сегодня я сделал вывод тайла в полупозиции. Ещё толком не тестировал, но на глазок вроде бы работает.

Ты извини, что я так отвечаю. Как-нить соберусь и напишу ответы более подробно. Но я не намерен никому навязывать XDev. Если оно заходит - тогда конечно. А нет - так нет.

По поводу скроллинга и Си - там самая ценность в том, что устроение экрана CGA сильно похоже на Львов. Ну да бог с ним, пока можно конечно и без плавной очистки экрана.

Но тем не менее ты в первый раз ответил, что ORG там не возможно!
Потом ответил, что возможно! ТАК ВСЕ ТАКИ?.. возможно или не возможно ?
Хотелось бы примеры РАБОТАЮЩИЕ использования АСМа в обероне для ПК-01!
Надеюсь что исходник булдера выложишь и там я увижу АСМ-вставки и т.д.
Ну из примера я ничерта не понял! Я уже вроде такое видел!
А что если я тебе в свою очередь скажу так - если автор захочет то зайдёт!
А если так ото... "засветить" XDev, что такое есть а далее как хотите... ну вот так оно и будет!
Ты ведь изначально наверняка не собирался портировать булдер на ПК-01?! Ну вот!.. на этом бы всё моё внимание и закончилось к XDev, я занимался бы я себе МАДЛом спокойно.
Решил портировать игрушку, причём очень хорошую и хорошо сделанную, - ну я не против помочь чем могу! МАДЛ можна и подвинуть вообще-то! Сама задумка XDev в общем-то хорошая, но много чего должно быть утрясено, чтобы оно не отпугивало пользоваться этим!
И вот у меня появилась мысль, - попытаться использовать его один раз установивши уже окончательную версию (последнюю доработку по "линии" ПК-01) и если это заработает, то не обновлять его уже никогда! Для другого то, кроме ПК-01, меня XDev не интересует!
Как-то так.
Далее, P_EMUL2021 "заточить" под возможность компилирования в XDev, (того кода, что написано на P_EMUL2021). Ну и XDev мне будет нужна только для окончательной компиляции в ЛВТ-файл, а всю разработку вести в P_EMUL2021, которая мной же и писана, значит и "приручена" мне будет! Тебе то чем плохо, что я так собираюсь XDev использовать ? Готовый то кода всё равно для XDev будет!
Ну соответственно - Слава Оберону, XDev и автору XDev!

Думаю решение правильное! А будет игрушка готова, ты скажешь - а нафиг оно вообще нужно, заморачиваться на этом, - тоже правильно! Основа то игрушки не в этих понтах (плавное гашение, скролы и т.д.)!

Понимаешь, я и сам сперва так думал. А потом попробовал, что ORG работает, по крайней мере, интерпретируется. Но там всё делается через вызов внешнего ассемблера.

Асм-вставки в zcc устроены таким образом, что вставляются прямым текстом в то, что нагенерировал Си. А Си распределяет адреса автоматически, то есть, ORG может сломать это распределение. А может и нет. Всё надо проверять.

В булдере я пока думаю обойтись без ORG, постараюсь скомпоновать так, чтобы весь вывод графики был выше адреса #8000, надеюсь, у меня это получится. Насчёт ресурсов тоже не всё понятно - лабиринты лучше бы размещать до этого адреса, а тайлы только после.
Ты и сейчас можешь увидеть асм-вставки в Си. Там Си вообще юзается как оболочка для асм-процедур.

Это даёт несколько больше преимуществ перед асм-вставками в Оберон. Например, можно использовать разные модели вызова (z88_fastcall, z88_callee). Из Оберона сейчас так делать нельзя. Я много думал над этим, прикидывал. Но до реализации конкретных флажков SDCC/zcc из-под Оберона я не созрел - всё равно их можно использовать только для кодовых процедур, а не для процедур на Обероне. Так что на Обероне вставлять куски кода можно (*@#asm код #endasm *), а способ с Си просто гибче.
Я боюсь, что окончательной версии XDev никогда не будет. А тем более K580Dev.

Напиши пару слов, что такое P_EMUL2021 и для чего он нужен.

Есть ещё игрушки, которые я хочу портировать на Оберон. Можно и для Львова. Посмотрим как пойдёт.

Да, по поводу таблички ты спрашивал. Я имел в виду табличку адресов экрана, которая создаётся в памяти с адреса 0..FF (младший байт) и 100..1FF старший. Вот этим кодом:

PROCEDURE SetTable;
  VAR scr, tab: INT16; n, val: SYSTEM.BYTE;
BEGIN
  scr := 4708H; (* Рабочий адрес экрана (8 байт (32 точки) слева пропускаем) *)
  tab := 0;
  FOR n := 0 TO 254 DO
    val := scr MOD 100H; SYSTEM.PUT(tab, val);
    val := scr DIV 100H; SYSTEM.PUT(tab+100H, val); INC(tab);
    INC(scr, 256 DIV 4);
  END
END SetTable;

Можешь посмотреть: последний пример (из поста выше) хорошо выравнен по центру экрана Львова?

Для начала о табличке -
а ну глянь результат:

procedure SYSTEM_PUT(c1,c2:Cardinal);
begin
Form1.mmo1.Lines.Add('$'+IntToHex(c1,4)+' - $'+IntToHex(c2,2));
end;

procedure TForm1.btn1Click(Sender: TObject);
  VAR scr, tab: word; n, val:BYTE;
begin
  scr := $4708;
  tab := 0;
  FOR n := 0 TO 254 DO begin
    val := scr MOD $100; SYSTEM_PUT(tab, val);
    val := scr DIV $100; SYSTEM_PUT(tab+$100, val); INC(tab);
    INC(scr, 256 DIV 4);    end;
END;

и что с этим всем делать то ?
SYSTEM_PUT иммется ввиду в параметрах (адрес,значение) ?

Доп.

FOR n := 0 TO 254 DO begin

Точно до 254, а не до 255 ?

Понятно! ну может перед "END." как-то писать асм-код, когда уже все остальное компилировано и т.д. ну расмотри! Ну да! после #8000 нужно только тайлы размещать И ПРОЦЕДУРУ ВЫВОДА ТАЙЛОВ!
(при условии что процедура вывода тайлов, включает и выключает Экранное озу) ну сам понимаешь, не будет например у меня , желания заморачиваться, что куда вставлять, т.е. что-то в си куда-то там в какой-то файл... что-то в оберон...
потом СИшный тот файл надо скоплириловать...
ерунда получится! По возможности добивайся чтобы всё можно было из оберона, ХОТЬ КАК-ТО делать! Вид мне может быть и не важен! я себе "слеплю" конвертер (декомпилятор) из кода-мадл в тот вид который нужно оберону например в строчный там Asm.Code("POP BC "); - я ж не вручную буду делать такое!
МАДЛа тоже никогда не будет окончательного! Ну тем не менее, его можна вполне использовать таким какой он есть СЕЙЧАС! Тем более что самому можно при желании нагородить в нём что кому хочеться.
( К слову, - МАДЛ вроде уже 10-12 скачиваний... и "тишина"... хоть бы кто "муркнул" что-то карме плохо )
Вот и XDev сделай стабильную версию! Навороты мне не обязательно!
А с возможностью асм-вставок мне вообще все остальное пофигу было бы! ой, ну я то написал в теме "P_EMUL2021" если сразу не понятно то жди когда выложу!
Я думал ты по примеру в той теме поймёшь!
ну можна было бы писать и проверять (отрабатывать) программу в среде дельфи, "завязывая" на процедуры ПК-01 такие как в обероне. А последний этап клмпиляцию в ЛВТ, делать обероном, немного "подрихтовав" исходник! ну как тут еще объяснить то ?!
Ты мадл видел ? так вот он процедурами-КР580 КОМПИЛИРУЕТ В ЛВТ, а P_EMUL2021 - НЕПОСРЕДСТВЕННО ВЫПОЛНЯЕТ! (ИЗ СРЕДЫ ДЕЛЬФИ)! И если "спрятать" команды-КР580 в такие же процедуры как в обероне, то писать можна не только командами КР580, а используя конструкции дельфи, такие какие есть в обероне! Ну и исходник разработанный и отработаный запусками, проверенный основательно в дельфи+P_EMUL2021 почти подойдёт для оберона, которым осталось только компилировать в ЛВТ!

Ну короче, ты может представить....
есть Дельфи и турбопаскаль.
Дельфи=Дельфи и турбопаскаль=оберон.
Я хочу писать в дельфи, но компилировать в турбопаскаль(оберон)!
Что мне для этого надо ?!
1. Написать процедуры в дельфи аналогичные по названию и работе в паскале на которые "завязывается" моя программа! Естественно "спрятать" их в отдельный модуль!
2.Использовать такие конструкции которые есть в турбопаскале!
В результате, я могу писать и отрабатывать програму в дельфи, а потом (последнее действие) - этот исходник компилить турбопаскаем!
ну так понятно ?!
"прокрути" это всё в голове вот только вместо паскаль, - оберон!
(а P_EMUL2021 - по сути это ДЛЛ-"крутилка"-эмулятора-ПК-01,
а "крутится" этот ДЛЛ командами (процедуры) из программы из среды дельфи)
Ну для начала булдер сделай.... ДА! НОРМАЛЬНО!

Можешь помочь с кодированием графики под Львов? Что-то я не могу понять как там кодируются цвета.

В общем, объём работ. Картинка пока что одна (тайл) - в Rsrc/SPRITES12.png
Это трава. Надо её закодировать в Rsrc.c в массив _Rsrc_Tiles. Секция // Grass встречается 2 раза - первый это тайл шириной 3 байта, а второй - тайл полупозиции шириной 4 байта, сдвинутый на 2 пикселя (полубайт) вправо. Для правильного вывода требуется, чтобы самые левые 2 пикселя каждой строки 4-байтного тайла были чёрными (сброшенными), и самые правые 2 пикселя тоже.

Палитру я использую 48H. Решил взять красный цвет вместо магенты, просто нет такой палитры, где чёрный фон был бы с магента, белым и циановым (а-ля CGA), а с магентовым фоном я решил не связываться, ну его. Трава у нас будет цианового цвета (в палитре 48H).

Вот для ясности скрин:

У тебя просьбы из серии "мне проще повесится", - с твоими Rsrc, тайлы-полутайлы, полупозиции,
сдвинутый на...
Я конечно рассмотрю более внимательно, что там к чему, но сильных надежд не питай, что я разберусь!
Поэтому пока мне быстрее и проще кинуть тебе, то что у меня есть по этой теме и как это знаю я!

Для начала вырезка из документации по ПК-01

		  -------------------------------
	         | X | 6 | 5 | 4 | X | 2 | 1 | 0 |
		  -------------------------------
		   |		   |
		   |		   |
		    --------------------- информация об
					  одном пикселе:

				    0...0...-фон
				    0...1...-B(голубой)
				    1...0...-G(зелёный)
				    1...1...-R(красный)



	  3		    5		       ---------------
					      | 0 | 0 | 1 | 1 |
   ---------------   ---------------	       ---------------
  | 0 | 0 | 1 | 1 | | 0 | 1 | 0 | 1 |   --->    |   |   |   |
   ---------------   ---------------	       ---------------
					      | 0 | 1 | 0 | 1 |
					       ---------------
						|   |   |   |
					       фон  B   G   R

Далее

Вот пример который я подкидывал Марату когда он писал свой эмуль
viewtopic.php?f=12&t=193&start=15#p2570
(тогда у меня как видишь был другой ник, я его сменил, потому что он злощастный )
Как видишь далее в той теме
viewtopic.php?f=12&t=193&start=15#p2578
Марат отписал "То что дохтур прописал !!! Спасибо !!!"
Значит разобрался! Значти разобраться можна всё таки...
и тебе тоже!
Вырежу тот код и сюда
входящий параметр b - байт Видео ОЗУ

pix1:=0;pix2:=0;pix3:=0;pix4:=0;
if (b and 128)=128 then pix1:=pix1+1; if (b and 8)=8 then pix1:=pix1+2;
if (b and 64)=64 then pix2:=pix2+1; if (b and 4)=4 then pix2:=pix2+2;
if (b and 32)=32 then pix3:=pix3+1; if (b and 2)=2 then pix3:=pix3+2;
if (b and 16)=16 then pix4:=pix4+1; if (b and 1)=1 then pix4:=pix4+2;

на выходе - переводит в цвета конкретных пикселей pix1,pix2,pix3,pix4.

Далее будет...

ДОП.
Пример из МАДЛа (будущего МАДЛа, еще не выложенного на_люди) преобразования в спрайт из строки (см.ниже пример использования процедура VarSprite.)
Значит, входящим параметрам процедуры "var Sprite:TSpriteLV;" и "Name:string255;", - не придаешь никакого значения! Команды из процедуры по обработке этих параметров я выкинул чтобы не мешали!

cl0,cl1,cl2,cl3:Char; - символьное значения конкретного цвета 0..3, заданное пользователем.
SpriteStr - спрайт в виде строки string, (примеры смотри ниже)

на выходе - в конце процедуры см. ТАМ ДВА РАЗА (при разных условиях)
"DB(TekByte);" , которая толкает каждый готовый байт, после того как он уже готов из преобразования 4 пикселей Видео ОЗУ (в байт), - на дальнейшую компиляцию!

Procedure VarSprite(var Sprite:TSpriteLV;Name:string255;cl0,cl1,cl2,cl3:Char;SpriteStr:string);
Var c1,lengthS:Cardinal;CountPix:Cardinal;{Счетчик пикселей}
TekByte:Byte;
Begin
If SpriteStr='' then begin
                       {!!!!!!!! Ошибка}
                     end else
 Begin
lengthS:=length(SpriteStr);CountPix:=0;TekByte:=0;
For c1:=1 to lengthS do    begin
if SpriteStr[c1]=cl0 then Begin CountPix:=CountPix+1; end else
if SpriteStr[c1]=cl1 then Begin CountPix:=CountPix+1;
    If CountPix=1 then TekByte:=TekByte+8;
    If CountPix=2 then TekByte:=TekByte+4;
    If CountPix=3 then TekByte:=TekByte+2;
    If CountPix=4 then TekByte:=TekByte+1;
                                end else
if SpriteStr[c1]=cl2 then Begin CountPix:=CountPix+1;
    If CountPix=1 then TekByte:=TekByte+128;
    If CountPix=2 then TekByte:=TekByte+64;
    If CountPix=3 then TekByte:=TekByte+32;
    If CountPix=4 then TekByte:=TekByte+16;
    end else

if SpriteStr[c1]=cl3 then Begin  CountPix:=CountPix+1;
    If CountPix=1 then TekByte:=TekByte+128+8;
    If CountPix=2 then TekByte:=TekByte+64+4;
    If CountPix=3 then TekByte:=TekByte+32+2;
    If CountPix=4 then TekByte:=TekByte+16+1;
                          end;
//1 пиксел цвет: 128+8//2 пиксел цвет: 64+4//3 пиксел цвет: 32+2//4 пиксел цвет: 16+1

If CountPix=4 then Begin  CountPix:=0;DB(TekByte);TekByte:=0; end;
                        end;
If CountPix<>0 then Begin DB(TekByte); end;
 end;
end;

Далее...
Примеры использования процедуры VarSprite.
Результаты которых можна увидеть в игре
"Лабиринт SAS" - http://pc01.lviv.ua/games/page.php?name=saslab
"Лабиринт SAS 2018" - http://pc01.lviv.ua/games/page.php?name=saslab2018

VarSprite(SPRITE241,'SPRITE241',' ','1','2','3',{Человечек}
'2      2'+
' 233332 '+
'  2222  '+
' 322223 '+
' 322223 '+
'  2222  '+
' 2 33 2 '+
'2      2'
);

VarSprite(SPRITE242,'SPRITE242',' ','1','2','3', {клад обычный242:}
'11111111'+
'12222221'+
'12111121'+
'12122121'+
'12122121'+
'12111121'+
'12222221'+
'11111111'
);
VarSprite(SPRITE243,'SPRITE243',' ','1','2','3',{Суперклад243:}
'33333333'+
'32222223'+
'32333323'+
'32322323'+
'32322323'+
'32333323'+
'32222223'+
'33333333'
);

VarSprite(SPRITE1,'SPRITE1',' ','1','2','3',{Голова змеи}
'3  33  3'+
' 333333 '+
' 333333 '+
'33333333'+
'33333333'+
' 333333 '+
' 333333 '+
'3  33  3'
);

VarSprite(SPRITE2,'SPRITE2',' ','1','2','3',{остальная часть змеи}
'   33   '+
'  3333  '+
' 33  33 '+
'33    33'+
'33    33'+
' 33  33 '+
'  3333  '+
'   33   '
);

VarSprite(SPRITE244,'SPRITE244',' ','1','2','3',{защита}
'  3  3  '+
'  3333  '+
'33233233'+
' 332233 '+
' 332233 '+
'33233233'+
'  3333  '+
'  3  3  '
);

Пока все.