[__GABCCRT__]

С этого момента я решил посвятить свой форум для описания того что я знаю о PABC(Pascal ABC).
Начну с идеи сделать свой CRT модуль с помощу уже имеющихся модулей.

Предпосылки:
1.Недоступный видеобуфер
В PABC нельзя модифицировать внутренний массив-буфер модуля CRT.
2.Модификация шрифта
В PABC всёравно приходиться подключать модуль GraphABC и использовать его функции...
3.Отладка алгоритмов
PABC удобная и простая платформа для отладки алгоритмов(хоть иногда у неё и бывают глюки).
В дальнейшем код можно спокойно переводить на другие ЯП(языки программирования).
4.Виртуализация
Это удобна для общего изучения внутренней работы компьютера или виртуальной машины(в общем я и делую кусок VM).

Чтобы было интересно, приведу код моей старой заготовки:

Код:

uses graphabc,timers,events;
var curtimer,curdelay,wherex,wherey:integer; key:char; keyflag,keyev,marked:boolean;
lastonkeypress:procedure(key:char);

function mx:integer;
 begin
  mx:=WindowWidth div TextWidth('A');
 end;
 
function my:integer;
 begin
  my:=WindowHeight div TextHeight('A');
 end;

procedure cursorproc(t:integer);
var pm:integer;
 begin
  if t=curtimer then
  begin
    pm:=PenMode;
    SetPenMode(pmnot);
    line((wherex-1)*TextWidth('A')  ,wherey*TextHeight('A')-1,
          wherex  *TextWidth('A')-1,wherey*TextHeight('A')-1);
    SetPenMode(pm);
    marked:=not marked;
  end;
 end;
 
procedure KeyHandler(c:char);
 begin
  while keyev do
  begin
  end;
  keyev:=true;
  if not keyflag then
  keyflag:=true;
  key:=c;
  keyev:=false;
 end;

function readkey:char;
 begin
  keyflag:=false;
  repeat
  until keyflag;
  readkey:=key;
 end;

procedure showcursor;
 begin
  if marked then
  marked:=false;
  sleep(1);
  starttimer(curtimer);
  sleep(1);
 end;

procedure hidecursor;
 begin
  sleep(1);
  stoptimer(curtimer);
  sleep(1);
  if marked then
  cursorproc(curtimer);
 end;

procedure gotoxy(x,y:integer);
 begin
  hidecursor;
  wherex:=x;
  wherey:=y;
  showcursor;
 end;

procedure setmode(mx,my,sz:integer);
 begin
  hidecursor;
  SetFontName('Lucida Console');
  SetFontSize(sz);
  SetWindowSize(mx*TextWidth('A'),my*TextHeight('A'));
  wherex:=1;
  wherey:=1;
  showcursor;
 end;
 
procedure writestr(s:string);
 begin
  if length(s)>mx then
  begin
 
  end
  else
  begin
    hidecursor;
    textout((wherex-1)*TextWidth('A'),(wherey-1)*TextHeight('A'),s);
    gotoxy(wherex+length(s),wherey);
  end;
 end;

 begin
  SetWindowCaption('My CRT');
  curdelay:=250;
  keyev:=false;
  marked:=false;
  curtimer:=CreateTimerExt(curdelay,cursorproc);
  sleep(1);
  setmode(80,25,12);
  sleep(1);
  lastonkeypress:=OnKeyPress;
  OnKeyPress:=KeyHandler;

  writestr('Hello World!');
  readkey;
  gotoxy(1,1);
  readkey;
  gotoxy(10,10);
  readkey;
  writestr('Hello World!');
  readkey;

  sleep(1);
  destroytimer(curtimer);
  if marked then
  cursorproc(curtimer);
  Onkeypress:=lastonkeypress;
  halt;
  sleep(1);
 end.


Я правда немного недописал процедуру writestr, ну да ладно. Этот код нуждается в доработке и переработке.
Итак, что тут есть:
1.Таймер курсора
2.Обработчик клавиатуры
3.Процедура задания "режима" setmode
4.Процедура вывода строки writestr
5.sleep(1); для минимализации глюков PABC, после halt обязательна(это если используете таймеры)

...

Извините, а нельзя, сначала, немного про сам PABC - на чем и под чем идет, где достать, насколько совместим со стандартом, как на нем удобнее писать..?

Хорошо, ты прав Gudleifr, начну с обьяснение что такое PABC(Pascal ABC).
Для некоторых: Про PABC.NET тут ни слова!

Некоторые сокращения:
PABC - Pascal ABC
TP - Turbo Pascal
FP - Free Pascal

Система Pascal ABC(из справки обычного PABC)

Система Pascal ABC предназначена для обучения программированию на языке Паскаль и ориентирована на школьников и студентов младших курсов.
По мнению авторов первоначальное обучение программированию должно проходить в достаточно простых и дружественных средах, в то же время эти среды должны быть близки к стандартным по возможностям языка программирования и иметь достаточно богатые и современные библиотеки стандартных подпрограмм.

Язык Паскаль признан многими российскими преподавателями как один из лучших именно для начального обучения. Однако, среда Borland Pascal, ориентированная на MS DOS, устарела, а среда Borland Delphi с ее богатыми возможностями сложна для начинающего программиста. Так, попытка начинать обучение с написания событийной программы в Borland Delphi вызывает у обучаемого массу сложностей и приводит к ряду неправильно сформированных навыков.

Система Pascal ABC основана на языке Delphi Pascal и призвана осуществить постепенный переход от простейших программ к модульному, объектно-ориентированному, событийному и компонентному программированию. Некоторые языковые конструкции в Pascal ABC допускают, наряду с основным, упрощенное использование, что позволяет использовать их на ранних этапах обучения. Например, в модулях может отсутствовать разделение на секцию интерфейса и секцию реализации. В этом случае модули устроены практически так же, как и основная программа, что позволяет приступить к их изучению параллельно с темой "Процедуры и функции". Тела методов можно определять непосредственно внутри классов (в стиле Java и C#), что позволяет создавать классы практически сразу после изучения записей, процедур и функций.

Ряд модулей системы программирования Pascal ABC специально создавался для учебных целей...

Т.е. дистрибутив PABC - учебная система программирования, которую можно встретить в школах(кроме FP). (про модули скажу позже)
Однако сей Pascal удобен почти для любых целей. Одно но - он позиционируется как интерпретатор(на высоком уровне).
На самом же деле он сначала компилирует в памяти, а потом исполняет скопилированный код(точно не знаю, что это за код...).
Также в систему встроен задачник(PT4).
Ну чтож, попробую ответить на вопросы админа.

Извините, а нельзя, сначала, немного про сам PABC - на чем и под чем идет, где достать, насколько совместим со стандартом, как на нем удобнее писать..?

1.Под чем идёт?
Начиная с XP точно. Попробую как-нибудь на 98-й.
2.Где достать?
Хороший вопрос. С развитием варианта на .NET PABC исчез с сайта школы http://sunschool.math.rsu.ru (нынче http://sunschool.mmcs.sfedu.ru/). Короче, можно в интернете найти.
Очень долго пользовался версией 3.0.1.32, недавно нашёл чуть новее 3.0.1.35, но основной файл на 403 Кб почему-то меньше. Относительно глюков не могу точно сказать, чтобы уменьшились(не знаю)...
3.Совместимость со стандартом
Как сказано выше, язык ближе всего к Delphi, однако возможно кое-какие конструкции чуть упращены или отсутствуют.
Есть ещё один момент. Некоторые зарезервированные слова окрашиваются редактором, но они отсутствуют в самой системе(к примеру слово asm, но ассемблера в системе нет).
4.Модули
System(скрыт, по умолчанию подключается(можно правда и uses system; но ругаться не будет))
CRT
GraphABC
Events
Utils
Containers
Timers
VCL
(редкоиспользуемые/неиспользуемые мною: )
Sounds
ABCObjects
ABCSprites
Robot (обычно для малых)
DrawMan (обычно для малых)
RobotMake
DrawManMake
PT4Make
PointRect(я когда-то даже сделал аналог для TP)

Всю основную информацию можно посмотреть в справке!

Подробности я потом опишу...
P.s. Я ещё подумаю как ответить на последний вопрос(Gudleifrа).

_KROL пишет:начну с обьяснение что такое PABC(Pascal ABC).

Спасибо, но у меня случился разрыв мозга между
"Язык Паскаль признан многими российскими преподавателями как один из лучших именно для начального обучения"
и
"обучение программированию должно проходить в достаточно простых и дружественных средах, в то же время эти среды должны быть близки к стандартным по возможностям языка программирования и иметь достаточно богатые и современные библиотеки стандартных подпрограмм".
Ведь первое, по инерции, относится к тому, первому специально учебному PASCAL, исчерпывающее описание которого было формально изложено на 30 страницах, и в сопровождение шли учебные книги Вирта. А второе - к Delphi-способу скриптования оконной BASIC-машины. Вещи, все же, взаимоисключающие.

А когда к этой телеге прицепили Лебедя, Рака и Щуку в виде "постепенный переход от простейших программ к модульному, объектно-ориентированному, событийному и компонентному программированию", я понял, что обучение программированию в подобной среде становится "делом самого утопающего".

Поэтому, будет несомненно полезно, если Вы будете как можно более полно персонифицировать свой процесс написания чего-либо на этой штуке. Тем более, что мой очень ограниченный опыт PASCAL-писания на Delphi никак не распространяется.

Да, поздравляю с Днем Рождения!

Спасибо!
Вы правы, трудно сказать что он действительно сильно походит на Delphi. Однако с окнами там тоже можно работать подключая модуль VCL...
А в теме надо основы Pascal расписывать?
P.s. Если найдётся время, то напишу сегодня про пару модулей.

CRT

Модуль CRT предназначен для работы с текстовым окном. Он написан для совместимости с Turbo Pascal. В качестве текстового используется графическое окно модуля GraphABC, при этом запрещено изменение размеров окна и ввод/вывод осуществляется непосредственно в текстовом окне. В результате вывода может осуществляться скроллирование текстового экрана.

Подключив модули CRT и GraphABC одновременно, можно совмещать вывод текста и графики. При этом, однако, запрещено изменение размеров окна, рекомендуется также перед графическим выводом отключать курсор. Наконец, совместное использование модулей CRT и Events не рекомендуется.

Только сейчас прочитал эти строки!
Т.е. я хотел всё сделать заново, как разработчик )
Далее идут константы цветов

const
Black=0; Blue=1; Green=2; Cyan=3;
Red=4; Magenta=5; Brown=6; LightGray=7;
DarkGray=8; LightBlue=9; LightGreen=10; LightCyan=11;
LightRed=12; LightMagenta=13; Yellow=14; White=15;

Цвет выводимого текста изменяется так же как и в TP, т.е. посредством

var TextAttr: byte;

procedure TextColor(c: byte);
// Устанавливает цвет символов.

procedure TextBackGround(c: byte);
// Устанавливает цвет фона.

Далее привожу список функций:

function ReadKey: char;
// Читает символ из буфера клавиатуры.

function KeyPressed: boolean;
// Определяет, была ли нажата клавиша.

procedure GotoXY(x,y: integer);
// Перемещает курсор в позицию (x,y).

function WhereX: integer;
// Возвращает x-координату текущего положения курсора.

function WhereY: integer;
// Возвращает y-координату текущего положения курсора.

procedure ClrScr;
// Очищает цветом фона все текстовое окно или текущее окно, установленное процедурой window. Устанавливает курсор в левый верхний угол очищенного окна.

procedure Window(x1,y1,x2,y2: integer);
// Определяет на экране текущее окно. Устанавливает курсор в левый верхний угол текущего окна

procedure ClrEol;
// Очищает все символы с позиции курсора до конца строки без перемещения курсора.

procedure DelLine;
// Удаляет строку, содержащую курсор.

procedure InsLine;
// Вставляет пустую строку в позиции курсора.

procedure Delay(ms: integer);
// Осуществляет задержку на ms миллисекунд.

В общем то же, что и в TP.

procedure LowVideo;
// Включает низкую интенсивность символов.

procedure HighVideo;
// Включает высокую интенсивность символов.

Никогда не понимал зачем это, даже в TP! В TP есть ещё и NormVideo, здесь видимо для совместимости.

procedure HideCursor;
// Скрывает текстовый курсор.

procedure ShowCursor;
// Делает текстовый курсор видимым.

В TP можно написать эти процедуры на встроенном ассемблере(тут x86 конечно же).

Код:

procedure hidecursor; assembler;
 asm
  mov ah,1
  mov ch,$20
  int $10
 end;

procedure showcursor; assembler;
 asm
  mov ah,1
  mov cx,$1012
  int $10
 end;


В FP есть, но не на всех платформах работает(у меня на Андроид не работало).

Новинки:

procedure CRTWindowSize(w,h: integer);
// Устанавливает размер текстового окна в символах.

procedure TextSize(sz: integer);
// Устанавливает размер символов в пунктах (по умолчанию 10 пунктов).

procedure TextNormal;
// Устанавливает нормальный стиль символов.

procedure TextBold;
// Устанавливает жирный стиль символов.

procedure ScrollingOff;
// Отключает прокрутку при выводе.

procedure ScrollingOff;
// Включает прокрутку при выводе.

"Совместимость":

procedure AssignCRT;
// Ничего не делает. Оставлена для совместимости.

procedure Sound(hz: integer);
// Ничего не делает. Оставлена для совместимости.

procedure NoSound;
// Ничего не делает. Оставлена для совместимости.

procedure TextMode(i: integer);
// Ничего не делает. Оставлена для совместимости.

Жалко что нельзя спикиром пикать

Блин! Я оказывается о модуле CRT в PABC кое-что не знал(т.е. не обращал позже внимание на эту страницу справки)
Вот пример, что можно отключить прокрутку!

Код:

uses crt;
 begin
  ScrollingOff;
  gotoxy(80,25);
  write('!123');
 end.


Но что можно сделать с помощу CRT?

Код:

// Стандартный пример из файла SAMPLES\CRT\BILL.PAS
uses CRT,GraphABC;

var
  ax,ay,vx,vy: integer;
  A: array [1..80,1..24] of char;

procedure CleanA;
var i,j: integer;
begin
  for j := 1 to 24 do
  for i := 1 to 80 do
    A[i,j] := ' '
end;

procedure Horiz(x,y,L: integer);
var i: integer;
begin
  for i := x to x+L-1 do
    A[i,y] := '*'
end;

procedure Vert(x,y,L: integer);
var j: integer;
begin
  for j := y to y+L-1 do
    A[x,j] := '*'
end;

procedure MinimalFill;
begin
  CleanA;
  Horiz(1,1,80);
  Horiz(1,24,80);
  Vert(1,2,22);
  Vert(80,2,22);
end;

procedure Fill;
begin
  Horiz(49,9,31);
  Horiz(49,14,31);
end;

procedure DrawScreen;
var i,j: integer;
begin
  MinimalFill;
  Fill;
  ClrScr;
  for j := 1 to 24 do
  for i := 1 to 80 do
    write(A[i,j])
end;

function NaPutiPrepiatstvie: boolean;
begin
  if (A[ax+vx,ay]<>' ') or (A[ax,ay+vy]<>' ') or (A[ax+vx,ay+vy]<>' ')
    then NaPutiPrepiatstvie := True
    else NaPutiPrepiatstvie := False
end;

procedure ChangeDirection;
begin
  if A[ax+vx,ay]<>' ' then vx := -vx;
  if A[ax,ay+vy]<>' ' then vy := -vy;
  if (A[ax+vx,ay]=' ') and (A[ax,ay+vy]=' ') and (A[ax+vx,ay+vy]<>' ') then
  begin
    vx := -vx;
    vy := -vy
  end;
  Sleep(10);
end;

procedure Show;
begin
  GotoXY(ax,ay);
  write('B');
end;

procedure Hide;
begin
  GotoXY(ax,ay);
  write(' ');
end;

procedure SetCoords (x,y: integer);
begin
  ax := x;
  ay := y
end;

procedure SetVeloc (vx0,vy0: integer);
begin
  vx := vx0;
  vy := vy0
end;

procedure MoveTo (x,y: integer);
begin
  Hide;
  SetCoords(x,y);
  Show
end;

procedure MoveOn (dx,dy: integer);
begin
  MoveTo(ax+dx,ay+dy);
end;

BEGIN
  SetWindowCaption('Биллиард (ностальгия по CRT)'); // Из модуля GraphABC
  textattr := White;
  clrscr;
  HideCursor;
  DrawScreen;

  SetCoords(70,13);
  SetVeloc(1,1);

  TextColor(Yellow);
  Show;
  repeat
    Delay(20);
    if NaPutiPrepiatstvie then ChangeDirection;
    MoveOn(vx,vy);
  until False;
END.


Тут только одна процедура задания заголовка окна из GraphABC(я её пометил коментарием в конце).
-------------------------------------------------------------------------------
Мои доп. процедуры, которые могут помочь при написании программ с использованием модуля CRT из PABC.

//Очистить буфер клавиатуры
procedure clearbuf;
begin
while keypressed do
readkey;
end;

// Считать символ с клавиатуры(расширено)
//1 Вариант
function _readkey:word; // или integer, при отладке в PABC значения переменных типа word почему-то не видятся!
// var result:word; <- В некоторых Pascalях встроена(как и в PABC) <*>
begin
result:=ord(readkey);
if result=0 then
result:=ord(readkey) shl 8;
//readkey:=result;
end;

// Считать символ с клавиатуры(расширено)
//2 Вариант
function _readkey:string;
// var result:string;
begin
result:=readkey+#0;
if result[1]=#0 then
result[2]:=readkey;
//readkey:=result;
end;

Вариант выбирайте как вам удобно.
<*> Для того чтобы функция возвратила результат надо писать
Имя_Функции:=...;
или лучше
Result:=...;
Просто Result пригождается тогда, когда нам необходимо взять результат, который уже может возвратить функция.
Если же мы напишем ...:=...Имя_Функции...; тогда пойдёт рекурсия этой же функции!!!
Однако в некоторых системах Result отсутствует(как я писал выше).

Вроде всё написал ос CRT. Ах да, причина изобретения мною _readkey.
В буфере клавиатуры CRT сохраняется сначала 0, если вы нажмёте какие-то спец. клавиши(up/down/...). Эта фигня наблюдается во всех стандартных модулях CRT(т.е. в PABC/TP/FP и т.д.).

P.s. В TP я написал такие функции(работают через BIOS):

Код:

function _keypressed:boolean;
label next;
var b:byte;
 begin
  asm
  mov b,0
  mov ah,1
  int 16h
  jz next
  mov b,1
next:
  end;
  _keypressed:=b=1;
 end;

function _readkey:word;
var w:word;
begin
 asm
  xor ax,ax
  int 22
  mov w,ax
 end;
 _readkey:=w;
end;


Даже можно проще:

Код:

function _readkey:word; assembler;
 asm
  xor ax,ax
  int 22
 end;


Ведь в TP аргумент BYTE/WORD(про остальные не знаю) возвращаются в AX!

как на нем удобнее писать..?

Извини, я не понял что ты имеешь в виду.
Что нибудь понял из вышеописанного из CRT?
P.s. Продолжу когда время появится, а так могу скинуть что-нибудь интересненькое, уже готовое.
(или ссылку на PABC могу выложить для временного скачивания)

_KROL пишет:

как на нем удобнее писать..?

Извини, я не понял что ты имеешь в виду.

Как организуется работа? Все делается в едином цикле: добавил кнопочку, написал для нее код, пририсовал следующую, привязал пропертями... и все это, не выходя из писательно-рисовательного окошка? Или по отдельности делаем в наиболее удобных редакторах, а потом связываем проектом?
Насколько переносим проект? Сколько весит прицепить к исполняемому файлу интерпретатор p-кода? (Кстати, компиляция PASCAL в промежуточный код, это историческое). Насколько чувствителен проект к путям, по которым размещены его компоненты? Надо ли эти директории рихтовать/отслеживать руками?
Наконец, как соотносится скорость писания в PABC с Вашей скоростью программирования? Т.е. Вы замечаете, что мысль уже ушла вдаль, пока Вы записывали ее начало? Или, наоборот, написав кусок, Вы вынуждены останавливаться и заново обдумывать уже написанное? Или пишете свободно - как думаете?

_KROL пишет:Что нибудь понял из вышеописанного из CRT?

Ну, CRT - это имитация старого DOS-овского драйвера ansi.sys. Т.е. раньше проще было включить драйвер, а сейчас - просто нарисовать, что надо. Не правда ли, красиво звучит: "Текстовая консоль с включением картинок"? Я, кстати, работаю над чем-то подобным (если Вы успели прочитать на моей страничке про "двухстраничный интерфейс").

Насколько нравится то, что Вы написали? Об этом можно будет судить, если Вы будете точнее формулировать, что хотите сделать и с какими целями. Т.к. PASCAL требует размазывать управление по всей программе, то либо стоит придумать какой-то метод укрупнения листинга (блок-схемы какие-нибудь), либо больше внимания уделять структурированию данных (по Вирту).

Теперь понятно.

Все делается в едином цикле: добавил кнопочку, написал для нее код, пририсовал следующую, привязал пропертями... и все это, не выходя из писательно-рисовательного окошка? Или по отдельности делаем в наиболее удобных редакторах, а потом связываем проектом?

Для создание своих окошок есть модуль VCL. Кое-что в нём отстутствует или недокументироано, но хоршо, в следующей "статье" я опишу возможность его использования. Писать в отдельных редакторах не надо...

Насколько переносим проект? Сколько весит прицепить к исполняемому файлу интерпретатор p-кода? (Кстати, компиляция PASCAL в промежуточный код, это историческое).

P-код возможно есть, но только в памяти, т.е. если он есть, то он скрыт от пользователя(иначе эта система не была бы учебной).

Насколько чувствителен проект к путям, по которым размещены его компоненты? Надо ли эти директории рихтовать/отслеживать руками?

Да, модули должны быть в той же директории, что и интерпретируемый файл. Однако, в отличие от TP, PABC пофиг какое название у модуля...
Нет, тут проще привести пример:

Код:

//Основная программа
... uses mod1; // подключаемый ею модуль
...

Файл mod1.pas

Код:

//Модуль
... unit anyname;
...

Ну ты надеюсь понял)

Наконец, как соотносится скорость писания в PABC с Вашей скоростью программирования? Т.е. Вы замечаете, что мысль уже ушла вдаль, пока Вы записывали ее начало? Или, наоборот, написав кусок, Вы вынуждены останавливаться и заново обдумывать уже написанное? Или пишете свободно - как думаете?

По разному, но когда требуется быстро создать форму можно использовать конструктор форм(Сервис[Меню]->Создать Форму).

"двухстраничный интерфейс"

Можно ссылку?

_KROL пишет:в следующей "статье" я опишу возможность его использования.

Не надо описывать модули, описывайте, пожалуйста, Вашу с ними работу.

_KROL пишет:P-код возможно есть

Непонятно. PADC, вообще, делает исполняемые файлы? Какого размера? Они переносимы сами по себе, или нужно еще библиотеки тащить?

_KROL пишет:По разному, но когда требуется быстро создать форму можно использовать конструктор форм(Сервис[Меню]->Создать Форму).

Речь идет не о рекламной скорости, а о соответствии скорости инструмента скорости Вашей работы. Впрочем, и про это, и про "двухстраничность", будет во фрагменте, который я сейчас готовлю (правда, там одни огрызки).

Не надо описывать модули, описывайте, пожалуйста, Вашу с ними работу.

оК. Постораюсь.

Непонятно. PADC, вообще, делает исполняемые файлы? Какого размера? Они переносимы сами по себе, или нужно еще библиотеки тащить?

Неа, увы делать исполняемые файлы PABC не умеет(то были рассуждения о том, что у него в памяти).

Речь идет не о рекламной скорости, а о соответствии скорости инструмента скорости Вашей работы.

Извини, но здесь я тебя почему-то плохо понимаю. Кто к чему привык, то к тому привык. Например, мне порою удобнее в PABC код набрать для вычесления чего-либо, чем открывать калькулятор. Однако... Неа, возможно и понял! Скорость в основном получается норамальная, если я знаю что набрать на клавиатуре и успеваю за своими мыслями(которые редко несуться со скоростью метеоров :]).

Надо наверное возвращаться к началу, ведь я вообще даже тему озаглавил "GABCCRT"!
Вот что у меня пока...

Код:

unit gabccrt; // v.1.1

interface //------------------------------------------------------------------//
uses graphabc,timers,events,containers;
////////////////////////////////////////////////////////////////////////////////
type tscreen=class
{Char Attr Redraw}
 cmem,amem,rmem:intarray; maxscrx,maxscry:integer;

 function  getChr(i:integer):char;    begin getChr :=char(cmem[i] mod 256); end;
 procedure putChr(i:integer;c:char);  begin cmem[i]:=ord(c); rmem[i]:=0;    end;
 function  getAttr(i:integer):char;  begin getAttr:=char(amem[i] mod 256); end;
 procedure putAttr(i:integer;c:char); begin amem[i]:=ord(c); rmem[i]:=0;    end;
 property chr [i:integer]:char read getChr write putChr;
 property attr[i:integer]:char read getChr write putChr;

 constructor create(x,y:integer);
  begin
  cmem:=intarray.create((x+1)*(y+1));
  amem:=intarray.create((x+1)*(y+1));
  rmem:=intarray.create((x+1)*(y+1));
  cmem.fill(ord('!'));
  amem.fill($0F);
  rmem.fill(0); // 0 - Redraw, -1 - yet
  maxscrx:=x;
  maxscry:=y;
  end;
 
 procedure resize(x,y:integer);
  begin
  cmem.resize((x+1)*(y+1));
  amem.resize((x+1)*(y+1));
  rmem.resize((x+1)*(y+1));
  end;

 destructor destroy;
  begin
  cmem.destroy;
  amem.destroy;
  rmem.destroy;
  end;
 
end;
////////////////////////////////////////////////////////////////////////////////
const startx=80; starty=25; startfont='Lucida Console'; startsize=11;
BW40=0;
CO40=1;  C40=CO40;
BW80=2;
CO80=3;  C80=CO80;
BW50=$80;
CO50=$81; C50=CO50;
var screen:tscreen; redrawdelay,curdelay:integer; wherex,wherey:integer;

procedure settextmode(sx,sy,sz:integer;font:string;col:boolean);
procedure setmode(vm:integer);
procedure showcursor;
procedure hidecursor;
function readkey:char;
implementation //-------------------------------------------------------------//
var colored:boolean; fname:string; fsize:integer;
    redrawt,cursort:integer; oldonkeypress:procedure(key:char);
    key:char; keyflag,marked:boolean;
    lockdrawhnd,lockcurhnd,lockkeyhnd:boolean;

procedure redrawproc;
const clBrown=$00004080; clLightGray=$00C0C0C0;
ColorPalette : Array[0..15] of integer = (clBlack,clMaroon,clBrown,clOlive,clNavy,clPurple,clTeal,clLightGray,clGray,clRed,clGreen,clYellow,clBlue,clFuchsia,clAqua,clWhite);

var i,j:integer;
    pc,ps,pw,pm:integer;
    bc,bs:integer;
    fc,fs,fsz:integer; fn:string;

procedure setbackcolor(cl:integer);
 begin
  setpencolor(cl);
  setbrushcolor(cl);
 end;

 begin
  while lockdrawhnd do
  begin
  end;
  lockdrawhnd:=true;

  pc:=pencolor; ps:=penstyle; pw:=penwidth; // pm:=penmode;
  bc:=brushcolor; bs:=brushstyle;
  fc:=fontcolor; fs:=fontstyle; fsz:=fontsize; fn:=fontname;
  setpenstyle(psSolid); setpenwidth(1); // setpenmode(pmcopy);
  setfontname(fname); setfontsize(fsize);

  for j:=0 to screen.maxscry-1 do
  for i:=0 to screen.maxscrx-1 do
  if screen.rmem[j*i+i+1]=0 then
    begin
    setpencolor(ColorPalette[screen.amem[j*i+i+1] and $F0 shr 4]);
    setbrushcolor(ColorPalette[screen.amem[j*i+i+1] and $F0 shr 4]);
    setfontcolor(ColorPalette[screen.amem[j*i+i+1] and $0F]);
    FillRect(i*TextWidth('A'),j*TextHeight('A'),(i+1)*TextWidth('A')-1,(j+1)*TextHeight('A')-1);
    TextOut(i*TextWidth('A'),j*TextHeight('A'),screen.chr[j*i+i+1]);
    screen.rmem[j*i+i+1]:=-1;
    end;

  lockdrawhnd:=false;
 end;
 
procedure cursorproc;
var pm:integer;
 begin
  while lockcurhnd do
  begin
  end;
  lockcurhnd:=true;
  pm:=PenMode;
  SetPenMode(pmnot);
  line(wherex  *TextWidth('A')  ,(wherey+1)*TextHeight('A')-1,
      (wherex+1)*TextWidth('A')-1,(wherey+1)*TextHeight('A')-1);
  SetPenMode(pm);
  marked:=not marked;
  lockcurhnd:=false;
 end;

procedure KeyHandler(c:char);
 begin
  while lockkeyhnd do
  begin
  end;
  lockkeyhnd:=true;
  if not keyflag then
  keyflag:=true;
  key:=c;
  lockkeyhnd:=false;
 end;
 
//----------------------------------------------------------------------------//

procedure settextmode(sx,sy,sz:integer;font:string;col:boolean);
 begin
  screen.resize(sx,sy);
  SetFontName(font);
  SetFontSize(sz);
  SetWindowSize((sx+1)*TextWidth('A'),(sy+1)*TextHeight('A'));
  colored:=col;
 end;
 
procedure setmode(vm:integer);
 begin
  case vm of
  BW40: settextmode(39,24,fsize,fname,false);
  CO40: settextmode(39,24,fsize,fname,true);
  BW80: settextmode(79,24,fsize,fname,false);
  CO80: settextmode(79,24,fsize,fname,true);
  BW50: settextmode(79,49,fsize,fname,false);
  CO50: settextmode(79,49,fsize,fname,true);
  else
    settextmode(79,24,fsize,fname,true);
  end;
 end;

procedure gotoxy(x,y:integer);
 begin
  hidecursor;
  wherex:=x;
  wherey:=y;
  showcursor;
 end;

procedure showcursor;
 begin
  if marked then
  marked:=false;
  sleep(1);
  starttimer(cursort);
  sleep(1);
 end;

procedure hidecursor;
 begin
  sleep(1);
  stoptimer(cursort);
  sleep(1);
  if marked then
  cursorproc;
 end;
 
function readkey:char;
 begin
  keyflag:=false;
  repeat
  until keyflag;
  readkey:=key;
 end;

initialization //-------------------------------------------------------------//
 SetWindowCaption('GABCCRT');
 redrawdelay:=100;
 curdelay:=250;
 lockdrawhnd:=false;
 lockcurhnd:=false;
 lockkeyhnd:=false;
 fname:=startfont; fsize:=startsize;

 screen:=tscreen.create(startx,starty);
 redrawt:=CreateTimer(redrawdelay,redrawproc);
 cursort:=CreateTimer(curdelay,cursorproc);
 gotoxy(0,0);
 setmode(C80);
 oldonkeypress:=onkeypress;
 onkeypress:=KeyHandler;
finalization //---------------------------------------------------------------//
 stoptimer(redrawt);
 stoptimer(cursort);
 if marked then
  cursorproc;
 screen.destroy;
 onkeypress:=oldonkeypress;
end.

Правда криво пока работает прорисовка, почему-то. Когда разберусь, то распишу весь этот код
---
Программа для проверки сего модуля:

Код:

uses GABCCRT;
begin
 readkey;
end.

Вот и релиз с комментами:

Код:

unit gabccrt; // v.1.2 (+ ///описания)
{
 Глючит однако PABC :))
 Особенность обработчиков:
 У каждого обработчика есть переменная (к примеру lockcurhnd).
 А внутри есть такой код

 if lockcurhnd=2 then exit;
  inc(lockcurhnd);
 while lockcurhnd>1 do
  begin
  end;
 ...
 dec(lockcurhnd);
 
 т.е. если запустится ещё одна процедура, то она будет стоять в очереди, пока
 не закончит предыдущая. Все "остальные копии" уходят через exit.
}

interface //------------------------------------------------------------------//
uses graphabc,timers,events,containers;
////////////////////////////////////////////////////////////////////////////////
type tscreen=class /// Класс памяти экрана. Так для меня проще - есть свойства.
{Char Attr Redraw} /// cmem - матрица символов | amem - матрица аттрибутов
                  /// rmem - Матрица "перерисовки"
 cmem,amem,rmem:intarray; maxscrx,maxscry:integer; /// Текущие пределы консоли
          // 0 - Перерисовываем, -1 - нет

 function  getChr(i:integer):char;    begin getChr :=char(cmem[i] mod 256); end;
 procedure putChr(i:integer;c:char);  begin cmem[i]:=ord(c); rmem[i]:=0;    end;
 function  getAttr(i:integer):char;  begin getAttr:=char(amem[i] mod 256); end;
 procedure putAttr(i:integer;c:char); begin amem[i]:=ord(c); rmem[i]:=0;    end;
 property chr [i:integer]:char read getChr write putChr;
 property attr[i:integer]:char read getChr write putChr;

 constructor create(x,y:integer);
  begin
  cmem:=intarray.create((x+1)*(y+1));
  amem:=intarray.create((x+1)*(y+1));
  rmem:=intarray.create((x+1)*(y+1));
  cmem.fill(ord(' ')); /// Создаём матрицы и заполняем значениями по умолчанию
  amem.fill($0F);
  rmem.fill(0);
  maxscrx:=x; /// Не забываем про границы!
  maxscry:=y;
  end;
 
 procedure resize(x,y:integer);
  begin
  cmem.resize((x+1)*(y+1));
  amem.resize((x+1)*(y+1));
  rmem.resize((x+1)*(y+1));
  maxscrx:=x;
  maxscry:=y;
  end;

 procedure redraw;
 var i:integer;
  begin
  rmem.fill(0);
  end;

 destructor destroy;
  begin
  cmem.destroy;
  amem.destroy;
  rmem.destroy;
  end;
 
end;
////////////////////////////////////////////////////////////////////////////////
/// Стартовые значения
const startx=80; starty=25; startfont='Lucida Console'; startsize=11;
/// Константы режимов
BW40=0;
CO40=1;  C40=CO40;
BW80=2;
CO80=3;  C80=CO80;
BW50=$80;
CO50=$81; C50=CO50;
/// Наш screen    | Значения задержек          | Тек. координаты
                                            /// (менять желательно через gotoxy)
var screen:tscreen; redrawdelay,curdelay:integer; wherex,wherey:integer;

procedure settextmode(sx,sy,sz:integer;font:string;col:boolean);
procedure setmode(vm:integer);
procedure showcursor;
procedure hidecursor;
function readkey:char;
implementation //-------------------------------------------------------------//
var colored:boolean; fname:string; fsize:integer;
    redrawt,cursort:integer; oldonkeypress:procedure(key:char);
    key:char; keyflag,marked:boolean;
    lockdrawhnd,lockcurhnd,lockkeyhnd:integer;

/// Процедура прорисовки экрана
procedure redrawproc;
const clBrown=$00004080; clLightGray=$00C0C0C0;
ColorPalette : Array[0..15] of integer =
(clBlack,clMaroon,clBrown,clOlive,  /// Где-то отрыл, но это цвета не как в CRT!
clNavy,clPurple,clTeal,clLightGray,
clGray,clRed,clGreen,clYellow,
clBlue,clFuchsia,clAqua,clWhite);

var i,j:integer;
    /// Переменные для сохранения пред. настроек
    pc,ps,pw,pm:integer;
    bc,bs:integer;
    fc,fs,fsz:integer; fn:string;

function bw(i:byte):integer;
 begin
  result:=i*$100000;
  result:=result+result shr 8+result shr 16;
 end;

 begin
  if lockdrawhnd=2 then exit;
  inc(lockdrawhnd);
  while lockdrawhnd>1 do
  begin
  end;
  /// Сохраняем пользовательские значения
  pc:=pencolor; ps:=penstyle; pw:=penwidth; // pm:=penmode;
  bc:=brushcolor; bs:=brushstyle;
  fc:=fontcolor; fs:=fontstyle; fsz:=fontsize; fn:=fontname;

  setpenstyle(psSolid); setpenwidth(1); // setpenmode(pmcopy);
  setfontname(fname); setfontsize(fsize);

  for j:=0 to screen.maxscry do
  for i:=0 to screen.maxscrx do
  if screen.rmem[j*(screen.maxscrx+1)+i+1]=0 then
    begin
    if colored then
      begin
      setpencolor(bw(screen.amem[j*(screen.maxscrx+1)+i+1] and $F0 shr 4));
      setbrushcolor(bw(screen.amem[j*(screen.maxscrx+1)+i+1] and $F0 shr 4));
      end
    else
      begin
      setpencolor(ColorPalette[screen.amem[j*(screen.maxscrx+1)+i+1] and $F0 shr 4]);
      setbrushcolor(ColorPalette[screen.amem[j*(screen.maxscrx+1)+i+1] and $F0 shr 4]);
      end;
    setfontcolor(ColorPalette[screen.amem[j*(screen.maxscrx+1)+i+1] and $0F]);
    FillRect((i)*TextWidth('A'),(j)*TextHeight('A'),(i+1)*TextWidth('A')-1,(j+1)*TextHeight('A')-1);
    TextOut((i)*TextWidth('A'),(j)*TextHeight('A'),screen.chr[j*(screen.maxscrx+1)+i+1]);
    screen.rmem[j*(screen.maxscrx+1)+i+1]:=-1;
    end;
  /// Восстанавливаем пользовательские значения
  setpencolor(pc); setpenstyle(ps); setpenwidth(pw); // setpenmode(pm);
  setbrushcolor(bc); setbrushstyle(bs);
  setfontcolor(fc); setfontstyle(fs); setfontsize(fsz); setfontname(fn);

  dec(lockdrawhnd);
 end;

/// Процедура прорисовки курсора
procedure cursorproc;
var pm:integer;
 begin
  if lockcurhnd=2 then exit;
  inc(lockcurhnd);
  while lockcurhnd>1 do
  begin
  end;

  pm:=PenMode;
  SetPenMode(pmnot); /// Рисуем курсор
  line(wherex  *TextWidth('A')  ,(wherey+1)*TextHeight('A')-1,
      (wherex+1)*TextWidth('A')-1,(wherey+1)*TextHeight('A')-1);
  SetPenMode(pm);
  marked:=not marked;

  dec(lockcurhnd);
 end;

/// Процедура отвечающая за нажатие клавиш
procedure KeyHandler(c:char);
 begin
  if lockkeyhnd=2 then exit;
  inc(lockkeyhnd);
  while lockkeyhnd>1 do
  begin
  end;
 
  if not keyflag then
  keyflag:=true;
  key:=c;

  dec(lockkeyhnd);
 end;
 
//----------------------------------------------------------------------------//

/// Установить видеорежим
procedure settextmode(sx,sy,sz:integer;font:string;col:boolean);
 begin
  hidecursor;
  StopTimer(redrawt);
  screen.resize(sx,sy);
  SetFontName(font);
  SetFontSize(sz);
  SetWindowSize((sx+1)*TextWidth('A'),(sy+1)*TextHeight('A'));
  colored:=col;
  screen.redraw;
  StartTimer(redrawt);
  showcursor;
 end;

/// Установить видеорежим из констант
procedure setmode(vm:integer);
 begin
  case vm of
  BW40: settextmode(39,24,fsize,fname,false);
  CO40: settextmode(39,24,fsize,fname,true);
  BW80: settextmode(79,24,fsize,fname,false);
  CO80: settextmode(79,24,fsize,fname,true);
  BW50: settextmode(79,49,fsize,fname,false);
  CO50: settextmode(79,49,fsize,fname,true);
  else
    settextmode(79,24,fsize,fname,true);
  end;
 end;

/// Переместить указатель
procedure gotoxy(x,y:integer);
 begin
  hidecursor;
  wherex:=x;
  wherey:=y;
  showcursor;
 end;

/// Включить укзатель
procedure showcursor;
 begin
  if marked then
  marked:=false;
  sleep(10);
  if not TimerEnabled(cursort) then
  starttimer(cursort);
  sleep(10);
 end;

/// Скрыть курсор
procedure hidecursor;
 begin
  if TimerEnabled(cursort) then
  stoptimer(cursort);
  sleep(10);
  if marked then
  cursorproc;
  sleep(10);
 end;

/// Считать клавишу
function readkey:char;
 begin
  keyflag:=false;
  repeat
  until keyflag;
  readkey:=key;
 end;

initialization //-------------------------------------------------------------//
 SetWindowCaption('GABCCRT');
 /// Устанавливаем переменные
 redrawdelay:=100;
 curdelay:=250;
 lockdrawhnd:=0;
 lockcurhnd:=0;
 lockkeyhnd:=0;
 fname:=startfont; fsize:=startsize;
 /// Инициализируем структуру экрана и таймеры
 screen:=tscreen.create(startx,starty);
 sleep(10); /// На всякий случай
 cursort:=CreateTimer(curdelay,cursorproc);
 sleep(10);
 redrawt:=CreateTimer(redrawdelay,redrawproc);

 setmode(C80);
 gotoxy(0,0);
 /// + обработчик клавиатуры
 oldonkeypress:=onkeypress;
 onkeypress:=KeyHandler;
finalization //---------------------------------------------------------------//
 stoptimer(redrawt);
 stoptimer(cursort);
 if marked then
  cursorproc;
 screen.destroy;
 onkeypress:=oldonkeypress;
end.

Если надо больше комментариев - пиши!

Да, и пример, котрый из-за глюков может исполнится не с первого раза(редко даже зависнуть может):

Код:

uses GABCCRT;
const s:string='Hello World!';
var i:integer;
begin
 for i:=1 to length(s) do
  screen.chr[i]:=s[i];
 //gotoxy(11,0);
 readkey;
end.

Просто пару раз запустите по F9.

_KROL пишет:Если надо больше комментариев - пиши!

Я понимаю так:
1. Либо я совершенно не понимаю, зачем это все надо, либо Вы сами не смогли выделить для себя основной смысл программы.
2. Как только этот самый смысл приобретет реальные черты, этот код надо будет выбросить и переписать по памяти.

...либо Вы сами не смогли выделить для себя основной смысл программы

В конечном итоге оно так и получилось. Но этот экспиремент мне на пользу чем-то пошёл...

Как только этот самый смысл приобретет реальные черты, этот код надо будет выбросить и переписать по памяти.

Ну, не факт, но возможно

"Расширенный" ввод строки (EXPECT) на Pascal ABC:

Код:

uses crt;

function _readkey:integer;
 begin
  result:=ord(readkey);
  if result=0 then
  result:=result+ord(readkey) shl 8;
 end;

function expect(maxsz:integer):string;
var s:string; i,pos,key,ox,oy:integer;
 begin
  s:='';
  pos:=0;
  repeat
  key:=_readkey;
  case key of
    13: //ENTER
    begin
      expect:=s;
      break;
    end;
    8: //BACKSPACE
    if pos<>0 then
      begin
      delete(s,pos,1);
      if wherex=1 then
        begin
        if wherey<>1 then
          begin
          gotoxy(80,wherey-1);
          write(' ');
          gotoxy(80,wherey-1);
          end;
        end
      else
        begin
        gotoxy(wherex-1,wherey);
        write(' ');
        gotoxy(wherex-1,wherey);
        end;
      ox:=wherex;
      oy:=wherey;
      dec(pos);
      for i:=pos+1 to length(s) do
        write(s[i]);
      write(' ');
      gotoxy(ox,oy);
      end;
    $4D00: // left
    if pos>0 then
      begin
      dec(pos);
      if wherex>1 then
        gotoxy(wherex-1,wherey)
      else
        gotoxy(80,wherey-1);
      end;
    $4B00: // right
    if pos<length(s) then
      begin
      inc(pos);
      if wherex<80 then
        gotoxy(wherex+1,wherey)
      else
        gotoxy(1,wherey+1);
      end;
    $5300: // del
    if pos<>length(s) then
      begin
      delete(s,pos+1,1);
      ox:=wherex;
      oy:=wherey;
      for i:=pos+1 to length(s) do
        write(s[i]);
      write(' ');
      gotoxy(ox,oy);
      end;
  else
    if (length(s)<>maxsz)and(key and $FF<>0) then
    begin
      inc(pos);
      insert(chr(key and $FF),s,pos);
      write(chr(key and $FF));
      ox:=wherex;
      oy:=wherey;
      for i:=pos+1 to length(s) do
      write(s[i]);
      gotoxy(ox,oy);
    end;
  end;
  until 1=2;
 end;

var s:string;
begin
 s:=expect(255);
 writeln;
 write(s);
end.