Разработчики: специалисты ООО "Технипром" на производственной базе ОАО "САВМА" (г. Кимры, Тверская обл.).
Сайт : http://www.techniprom.com/.

 - Система имеет модульную структуру и традиционное управление в режиме меню с текстовым и графическим редакторами, отладчиком и всеми штатными для ЧПУ циклами работы станка.
 - Удобный текстовый редактор - все как на персональном компьютере.
 - Имеется возможность отрисовать траекторию в разных масштабах.
 - Система обеспечивает автоматический контроль скорости и ускорения на профиле обрабатываемой детали, а также торможение инструмента в углах профиля - стандартными функциями динамики: G9, G27-29.
 - Помимо линейной и круговой ЧПУ "АЛЬФА" имеет кубическую интерполяцию.
       Тут имеется ньюанс: к сожалению, в тех версиях ЧПУ с которыми я был знаком, ЧПУ "АЛЬФА" не могло вести обработку непосредственно по сплайн - функциям, которые могут выводить в современных САПР. Кубическая интерполяция реализуется в ней сплайн - функциями непосредственно внутренними алгоритмами ЧПУ на основе точек УП G1 X.Y.Z.  на основе кривизны отрезков, то-есть решается обычная задача построения сплайна на основе точек и кривизны линии.. Аналог G5 - имеется в УЧПУ Sinumerik, =>, COMPCURV - которая аппроксимирует G1-кадры полиномами 5-го порядка.

 - Первый, думаю самый важный недостаток : это неспособность УЧПУ работать по принципу RTCP [Rotate Tool Center Point]- то-есть отслеживать "кончик" инструмента при многокоординатной обработке.
 - второй, из-за конструктивных особенностей построений ЧПУ - настройка и привязка под конкретное оборудование вызывала необходимость влезать во внутренности исходного кода, вносить необходимые изменения и заново компилировать. Опять же, это касалось в основном станков с многокоординатным оборудованием.
 - третий - эээ это скорее не недостаток, а пожелание разработчикам, хотя, я думаю они будут против. :):) Хотелось бы, чтобы, ЧПУ поддерживало и язык той ЧПУ на место которой оно вставало.( То - есть, если проводилось замена станка со стойкой Н33, то хотелось чтобы Альфа и поддерживала команды этой системы.) Но, думаю, эта моя мысль - утопична и по форме, и по содержанию. :)
  - в пятых - к сожалению, это УЧПУ нельзя было использовать для высокоскоростного фрезерования. Связка "автоматика - механика" просто это не вывозила.

16k20_alpha.zip
Постпроцессор для токарного станка 16A20Ф3 с УЧПУ Альфа. Использовался только для сложно-теоретических плоскостей, сфер.

fp-17smn_alpha.zip

 - Постпроцессор для станков ФП-17СМН , ФП-17, ФП-7 , ФП-27, и многих других -  с УЧПУ Альфа
   Очень интересная система - возможности которой использовались не полностью:
 - циклы;
 - G5 - сплайн - эта вещь очень хорошая!! Правда, ограничена по применению.
 - и многое другое...

ma655c5_alpha.zip  - Постпроцессор для МА655С5 (X,Y,Z,А,B) с УЧПУ Альфа:
     - циклы не реализованы в многокоординатной обработке.
 программа NC - создается от точки подвески инструмента !!

fp-14v7_alpha.zip - Постпроцессор для ФП-14B7 (X,Y,Z,А,B) с УЧПУ Альфа:
    - циклы не реализованы в многокоординатной обработке.
программа NC - создается от точки подвески инструмента !!

файлов конфигурации:


Все файлы конфигурации представлены в открытом текстовом виде и могут редактироваться как с помощью внутреннего редактора системы "АЛЬФА" так и с помощью любого ред������ктора систем DOS или Windows

BASE.INI –основные параметры системы и станка,
ERRORS.INI –список ошибок,
MESSAGES.INI –список сообщений,
GTABLE.INI –таблица совместимости G-функций,
HELP.HLP –файл справочной информации,
SCREW.INI –коррекция исполнительного механизма (винта) координатных осей,
UAO.INI –таблица начальных точек,
DL.INI –таблица коррекции на длину и радиус инструмента,
E100.INI –список сохраняемых параметров-переменных,
STRINGS.INI –список текстовых строк,
SET.INI –список параметров установок оператора.
 

 DPMI16BI.OVL,  EGAVGA.BGI, HELP.HLP, LITT.CHR , HSLDLL.DLL
  - шрифты, файлы помощи, графические драйвера, оверлеи для работы с памятью, библиотеки для работы с внешними устройствами.
 

ALPHA.PAS

- является сердцем системы.
 авторами системы отдается в открытом виде для расширения возможностей и добавления разных меню.

Program Alpha;
{...................................................}

Uses Crt,Types,Base,User,Picture;

{-----------------------------------------------------------------------}
Var {--------------------------------------------------------------}

Mode: String[4];
i,k: Integer;
{-----------------------------------------------------------------------}

Begin
With Sys do

REPEAT
{...................................................}

GetKeyBoard;
if RGS[7] =0 then Menu;
UserView;

{....................................................................}

if RGS[1]> 0 then
begin
{....................................................................}

Mode:=ModeStr[Switch[SW.Mode].Last];

{=============================================== SYSTEM MODES ==========}

if ((Mode ='AUTO') or (Mode ='STEP'))
and (GetButton(SB.CycleOn)> 0) then
begin
k:=0;
if (PrgState =2) and (not Profil) then k:=20;
for i:=1 to iA do With Axis[i]^ do if not Init then
begin Message[3]^[26]:=Letter; k:=3; Break; end;

if ReadCD(32) =0 then CycleError.Next:=136;
if ReadCD(30) =0 then CycleError.Next:=135;
if ReadCD(50) =0 then CycleError.Next:=134;
if (ReadCD(53)= 0) or (ReadCD(52) =1) then CycleError.Next:=131;
GetBoxCode;
if Spindle^.iBox =0 then CycleError.Next:=130;

if RunTimeError.Next or CycleError.Next> 0 then k:=8;
if k> 0 then Send.Next:=k else
if Mode ='AUTO' then Process(1) else Process(2);
end;
{....................................................................}

if (Mode ='MDI ')
and StrRead(0,1,79,$0F,0,1,ProcMDI,StrMDI^) then
Process(3);
{....................................................................}

if (Mode ='HOME') and (GetButton(SB.CycleOn)> 0) then
begin
if GetAxisCode then Continue;
With Axis[iAxis]^ do
begin
With UserStack(1)^.Stack do
begin
Cod:=0; gA:=1; bF:=FHome.High; nUAO:=0; AX0:=TableUAO[0]^;
With Limit do D[iAxis]:=2*(High-Low);
end;
With UserStack(2)^.Stack do
begin D[iAxis]:=-D[iAxis]; bF:=FHome.Low; end;
With UserStack(3)^.Stack do
begin D[iAxis]:=0; bF:=FHome.High; end;
Init:=False; Process(4);
if Init then
begin Message[10]^[22]:=Letter; Send.Next:=10; end;
end;
end;
{....................................................................}
{================================================= USER MODES ==========}

if (Mode ='MANU') and (GetButton(SB.CycleOn)> 0) then
begin
if GetDirectCode or GetAxisCode then Continue;
With UserStack(1)^.Stack do With Axis[iAxis]^.Limit do
begin
Cod:=0; gA:=0;
if iDirect =1 then D[iAxis]:=High else D[iAxis]:=Low;
end;
Process(5);
With Axis[iAxis]^ do
if (C0 =Limit.High) or (C0 =Limit.Low) then Send.Next:=7;
end;
{.................................................................}
{Technology}
{.................................................................}

if (Mode ='JOG ') and (GetButton(SB.CycleOn)> 0) then
begin
if GetDirectCode or GetAxisCode then Continue;
With UserStack(1)^.Stack do With Axis[iAxis]^ do
begin
Cod:=1; gA:=1; bF:=FWork.Low;
if iDirect =1 then D[iAxis]:=D[iAxis]+JOG/Scale
else D[iAxis]:=D[iAxis]-JOG/Scale;
With Limit do
begin
if D[iAxis]> High then D[iAxis]:=High;
if D[iAxis] <Low then D[iAxis]:=Low ;
end;
end;
Process(7);
With Axis[iAxis]^ do
if (C0 =Limit.High) or (C0 =Limit.Low) then Send.Next:=7;
end;
{....................................................................}
.........................
.........................
.........................
.........................
 {....................................................................}

Case KeyBoard[1] of
F1: Inform(False);
AltF1: Inform(True);
F2: SetUp(0);
F3: Debug;
F4: Edit;
F6: ReadNote(0);
F7: ReadNote(1);
F9: begin
ReSetStream(CycleError);
ReSetStream(RunTimeError);
end;
F8: if PrgState> 0 then With PrgTime do
begin
Active:=Active xor 1; Change:=True;
end;
AltF8: if PrgState> 0 then With PrgTime do
begin
FillChar(Hour,3,0);
Change:=True; Send.Next:=76;
end;

end;

Until (KeyBoard[1] =#16) or (ReadCD(1) =0);
{...................................................}

Sys.Destroy;

{-----------------------------------------------------------------------}
End.

USER.PAS

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

 Unit User;

{-----------------------------------------------------------------------}
INTERFACE
{-----------------------------------------------------------------------}

Procedure GetBoxCode;
Procedure GetTCode;

Function Machine: Boolean;

{-----------------------------------------------------------------------}
IMPLEMENTATION
{-----------------------------------------------------------------------}

Uses Crt,Types,Base;

Var {--------------------------------------------------------------}

i: Integer;
{................................................}

{-----------------------------------------------------------------------}

Procedure GetBoxCode;
Begin
With Sys do With Spindle^ do
Case ReadCD(47)+ReadCD(48)*2 Of
1: iBox:=1;
2: iBox:=2;
else iBox:=0;
end;
End;

{-----------------------------------------------------------------------}

Procedure GetTCode;
Begin
With Sys do
begin
T0:=1;
end;
End;
.........................
.........................
.........................
.........................
{-----------------------------------------------------------------------}
{ INIT }
{-----------------------------------------------------------------------}

Begin
With Sys do
begin
{.......................................................}

ModeStr[0]:='...?';
ModeStr[1]:='MDI ';
ModeStr[2]:='MANU';
ModeStr[3]:='JOG ';
ModeStr[4]:='STEP';
ModeStr[5]:='AUTO';
ModeStr[6]:='PROF';
ModeStr[7]:='HOME';
ModeStr[8]:='ESC ';

{.......................................................}

Liquid:=76;
UserRunTime:=Auto;
{.......................................................}
{M-procedure}

With MProc[00] do begin Refer:=M00; State:=0; end;
With MProc[01] do begin Refer:=M01; State:=0; end;
With MProc[02] do begin Refer:=M02; State:=0; end;
With MProc[03] do begin Refer:=M03; State:=1; end;
With MProc[04] do begin Refer:=M03; State:=1; end;
With MProc[40] do begin Refer:=M04; State:=3; end;
With MProc[41] do begin Refer:=M04; State:=3; end;
With MProc[42] do begin Refer:=M04; State:=3; end;
With MProc[05] do begin Refer:=M05; State:=0; end;
With MProc[06] do begin Refer:=M06; State:=0; end;
With MProc[08] do begin Refer:=M08; State:=1; end;
With MProc[09] do begin Refer:=M09; State:=1; end;
With MProc[13] do begin Refer:=M13; State:=1; end;
With MProc[14] do begin Refer:=M13; State:=1; end;
With MProc[30] do begin Refer:=M30; State:=0; end;
{.......................................................}
{H-procedure}

With HProc[00] do begin Refer:=H00; State:=0; end;
With HProc[01] do begin Refer:=H01; State:=0; end;
With HProc[02] do begin Refer:=H02; State:=0; end;
{.......................................................}

end;

{-----------------------------------------------------------------------}


End.

 - ядро системы.

 Unit Base;

{-----------------------------------------------------------------------}
INTERFACE
{-----------------------------------------------------------------------}

Uses Crt,Dos,Types,Debug;

Type {--------------------------------------------------------------}

TSystem = object(TDebug)

Constructor Create;
Destructor Destroy;

public {-----------------------------------------}

UserRunTime, UserView: Proc;
Vector: Double;

MHCode : Byte;
SCode : Word;
UserError: Byte;
iAxis : Byte;
iDirect : Byte;
Liquid,
Air : Byte;
StrMDI : ^PathStr;
{...................................................}

Procedure GetKeyBoard;
Procedure ReSetSpindle;
Procedure ReSetState;
Procedure ReSetDis;
Procedure ReSetVar;
Procedure ReSetProgram(Level: Byte);

Function Delay(TDelay: Double): Boolean;
Function Signal(Index,Bin,nError: Byte;
TDelay,TSignal: Double): Boolean;
Procedure Check(Index,Bin,nError: Byte; Impuls: Word);

Function GetAxisCode: Boolean;
Function GetDirectCode: Boolean;
Procedure SetJOG;
Procedure SetUAO;
Procedure ReSetAxis(Item: Byte);
Function UserStack(n: Byte): PtrStack;
Procedure WriteNote(Cmd: Byte);

Function Profil: Boolean;
Procedure Process(ChooseMode: Byte);
{...........................................................}

private {----------------------------------------}

DL0 : LongInt;
ID : Byte;
WorkM : MRec;
ParamSpl : Double;
ChkNote : Byte;
{.........................}

BufMDI: PtrMDIBuf;
iMDI: Byte;
ExitMDI: Boolean;
PosXMDI: Byte;
{.........................}

IRQ : Pointer;
{.........................}

Procedure Mov;
Procedure Speed;

{...................................................}

end; {object}
{....................................................................}

Var {--------------------------------------------------------------}

SYS: TSystem;
{................................................}

Procedure ProcMDI;

{-----------------------------------------------------------------------}
IMPLEMENTATION
{-----------------------------------------------------------------------}

Const {--------------------------------------------------------------}

FileTmp = 'TMP';
FileBak = 'BASE.BAK';
FileIni = 'BASE.INI';
FileErr = 'ERRORS.INI';
FileTab = 'GTABLE.INI';
FileHlp = 'HELP.HLP';
FileNote = 'NOTE.INF';
FileStory = 'STORY.INF';
FileCache = 'CACHE.TMP';

Var {----------------------------------------------------------------}

S: ComStr;
UByte: PtrByte;
.........................
.........................
.........................
.........................
 {$I+}

WriteNote(0);
if FileSize(fNote)> MaxWriteNote then
begin
Erase(fStory);
ReName(fNote,FileStory);
Assign(fNote,FileNote); ReWrite(fNote);
end;
Close(fNote); Close(fStory);

{$I-}
{......................................................................}

TextMode(CO40);
Frame(5,7,35,11,$07,$0E,$07,1,'');
GotoXY(10,10); WriteLn('‘€‘’…ЊЂ ‡Ђ‚…ђ€‹Ђ ђЂЃЋ’“');
RGS[1]:=0; With RunTimeError do Last:=Next; PrgState:=0;
if Delay(3) then;
TextMode(CO80);

With Time do
begin
repeat Port[$70]:=$0A; until Port[$71] <$80;
Port[$70]:=7; Day:=Port[$71];
Port[$70]:=8; Month:=Port[$71];
Port[$70]:=9; Year:=Port[$71];

SetTime((Hour Div 16)*10 +Hour Mod 16,
(Minute Div 16)*10 +Minute Mod 16,
(Second Div 16)*10 +Second Mod 16,50);

SetDate((Year Div 16)*10 +Year Mod 16 +2000,
(Month Div 16)*10 +Month Mod 16,
(Day Div 16)*10 +Day Mod 16);
end;

Freq(0); SetIntVec($1C,IRQ);
Port[OUT[1]^.Canal[1]]:=0;

{......................................................................}

Halt;
End;

{-----------------------------------------------------------------------}

Begin

Sys.Create;
End.

 - очень важный модуль системы. Именно он отвечает за синтаксис УП, её компиляцию, расчет координат, и размещение УП в куче памяти.

 Unit Compile;

{-----------------------------------------------------------------------}
INTERFACE
{-----------------------------------------------------------------------}

Uses Types;

Type {--------------------------------------------------------------}

TCompile = object

public {-----------------------------------------}
{...................................................}

iA: Byte;
nA: Byte;
Axis: array[1..Max_Axis+S_coord] of PtrAxis;
{...................................................}

Spindle: PtrSpindle;
FRange : DLimRec;

TLimit : ILimRec;
T0 : Byte;
{...................................................}

MainAxis : Byte;
DrCircle : Double;
{...................................................}

UCod: UCodRec;
{...................................................}

TableUAO: array[0..MaxCountUAO] of PtrAxisArr;
TableDL : array[0..MaxCountDL] of PtrCorrect;
TableGF : array[0..MaxCountGF] of PtrTableG;
{...................................................}

Error : array[0..Max_Error] of PtrError;
Message: array[0..Max_Message] of PtrError;
{...................................................}

Ring,Free,UA,
PtrStart,PtrEnd: StrPtr;

ARing,BRing,
UStart,UEnd,
UHold,
PrgEnd,PrgPoint: PtrStack;
{...................................................}

InitStack : CompRec;
EVar : VarRec;
{...................................................}

MProc: array[0..Max_ProcM] of ProcRec;
HProc: array[0..Max_ProcH] of ProcRec;
ISO : array[1..MaxCharISO] of ISORec;
{...................................................}

CountCLS: Byte;
TableCLS: array[0..MaxCountCLS] of CLSRec;
CountLAB: Byte;
TableLAB: array[0..MaxCountLAB] of LABRec;
LevelCLS: Byte;
CLS: array[1..MaxLevelCLS] of StrPtr;
LevelRPT: array[0..MaxCountCLS] of Byte;
RPT: array[1..MaxLevelRPT] of RPTRec;
{...................................................}

Correction: Boolean;
ItemX,ItemY: Byte;
Prim0,Prim1: PtrPrim;
Req: Double;
UE,UCheck: PtrStack;
{...................................................}

Time: TimeRec;
Timer: StandartTimerRec;
PrgTime: PrgTimeRec;
{...................................................}

FWork: DLimRec;
FUVR: Double;
{.........................................................}

Function Calc(UCalc: PtrStack; Var S: String;
Start, Finish: Byte): Double;
Procedure IndexXY(gB: Byte);
Procedure PreProcess;
Procedure DeCoder;
{.........................................................}

private {----------------------------------------------}

Procedure GetNameCode(Prefix: Boolean);
Procedure CheckEndLine;
{.........................................................}

end;

{-----------------------------------------------------------------------}
IMPLEMENTATION
{-----------------------------------------------------------------------}

Type {--------------------------------------------------------------}

CharsType = set of #32..#90;
SetCode = set of 0..99;

Const {--------------------------------------------------------------}

LETTER: CharsType = ['A'..'Z','_'];
CHARS: CharsType = ['A'..'Z','_','0'..'9'];
_INT: CharsType = ['0'..'9'];
FLOAT: CharsType = ['0'..'9','.','-','+'];
SETG: SetCode =
[0..5,9,17..19,27..29,38..42,45..48,
70..71,79..91,94,97..99];

_UCV= $5643; _USO= $4F53; _UAO= $4F41; _UOT= $544F;
_UIO= $4F49; _DIS= $5349; _RPT= $5450; _ERP= $5052;
_CLS= $534C; _SUB= $4255; _ESU= $5553; _TMR= $524D;

_BNC= $434E; _BGT= $5447; _BGE= $4547; _BLT= $544C;
_BLE= $454C; _BEQ= $5145; _BNE= $454E; _COL= $4C4F;

_HLT= $544C; _USP= $5053;
.........................
.........................
.........................
.........................
 {--------------------------------------------------------------------}
{Check}

CheckLimits; if CompErr> 0 then goto STOP;

{--------------------------------------------------------------------}
{Macros}

if gG> 80 then
if Cod <$7 then
begin
{...................................................................}
{1}

if Z80-R99> eps then begin CompErr:=22; goto STOP; end;
M80:=bM.Last; J80:=gJ;
Cod:=0; gA:=0; gJ:=0; bM.Last[0]:=0;
{...................................................................}
{2}

if Abs(D[MainAxis]-R99)>= eps then
begin
{ if R99-D[MainAxis]> eps then begin CompErr:=22; goto STOP; end;}
if UpStack then goto STOP;
With UEnd^.Stack do D[MainAxis]:=R99;
end;
{...................................................................}
{3}

if (gG =83) and (K80> 0) then
begin
p:=R99-K80;
While p> Z80 do
begin
if UpStack then goto STOP; With UEnd^.Stack do
begin Cod:=1; gA:=1; D[MainAxis]:=p; end;
if UpStack then goto STOP; With UEnd^.Stack do
begin Cod:=0; gA:=0; D[MainAxis]:=R99; end;
if UpStack then goto STOP; With UEnd^.Stack do
D[MainAxis]:=p+1;
p:=p-K80;
end;
end;

if UpStack then goto STOP; With UEnd^.Stack do With bM do
begin
Cod:=1; gA:=1; D[MainAxis]:=Z80;

Case gG of
84: begin Prev[0]:=1; Prev[1]:=3; end;
88: begin Prev[0]:=1; Prev[1]:=4; end;
82,89: begin gJ:=80; Float:=P80; end;
86: begin Prev[0]:=1; Prev[1]:=3; Last[0]:=1; Last[1]:=5; end;
87: begin Prev[0]:=1; Prev[1]:=3; Last[0]:=1; Last[1]:=0; end;
end; {Case}
end;
{...................................................................}
{4}

if UpStack then goto STOP; With UEnd^.Stack do
if gG in [81..83,86,87] then
begin
Cod:=0; gA:=0;
if gN =99 then D[MainAxis]:=R99 else D[MainAxis]:=R98;
gJ:=J80; bM.Last:=M80;
end else
begin
Cod:=1; gA:=1;
D[MainAxis]:=R99;

if gN =98 then
begin
if UpStack then goto STOP;
With UEnd^.Stack do
begin
Cod:=0; gA:=0;
D[MainAxis]:=R98;
end;
end;

With UEnd^.Stack do With bM do
begin
gJ:=J80; Last:=M80;
if gG in [84,88] then
begin
Prev[0]:=1; if gG =84 then Prev[1]:=4 else Prev[1]:=3;
if Last[0]> 2 then begin CompErr:=2; goto STOP; end;
Inc(Last[0]); Last[Last[0]]:=5;
end;
end;
end;
end {Cod <$7} else
{...................................................................}
{R only}

if (gN =99) and (Abs(D[MainAxis]-R99)>= eps) then
begin
Cod:=0; gA:=0;
D[MainAxis]:=R99;
end;

{--------------------------------------------------------------------}

end; {Format ISO}
end; {With UEnd^.Stack}

UNTIL UA =PtrEnd;
EXIT;
{....................................................................}

STOP: UEnd:=UEnd^.UPred;

End;

{--------------------------------------------------------------------------}

End.

 Unit Debug;

{-----------------------------------------------------------------------}
INTERFACE
{-----------------------------------------------------------------------}

Uses Types,Edit;
{...................................................}

Type {--------------------------------------------------------------}

TDebug = object(TEdit)

public {------------------------------------------}

Send, CycleError, RunTimeError : StreamRec;
{...................................................}

Accel,
Dynam : DLimRec;
CorrectF,
CorrectS: CorrectRec;

SAccel : Word;
Root : Word;
JOG : Double;
CLimit : ILimRec;
{...................................................}

nWheel : Byte;
Wheel : array[0..Max_Wheel] of WheelRec;
{...................................................}

TableIO : array[1..MaxTableIO] of PtrIO;
IoCanals, InpCanals, OutCanals: Word;
{...................................................}

nDACCard: Byte;
DAC: array[1..Max_DACCard] of PtrDAC;
nPCLCard: Byte;
PCL: array[1..Max_PCLCard] of PtrDrv;
nINPCard: Byte;
INP: array[1..Max_INPCard] of PtrDrv;
nOUTCard: Byte;
OUT: array[1..Max_OUTCard] of PtrDrv;
{...................................................}

nButton: Byte;
Button : array[0..Max_Button] of ButtonRec;
SB : StandartButtonRec;
{...................................................}

nSwitch: Byte;
Switch : array[0..Max_Switch] of SwitchRec;
SW : StandartSwitchRec;
{...................................................}

nLamp : Byte;
Lamp : array[0..Max_Lamp] of Byte;
HL : StandartLampRec;
{...................................................}

Procedure ReSetDACPort(Item: Byte);
Procedure ReSetPCLPort(Item: Byte);
Function StateNulLabel(Item: Byte): ShortInt;
Procedure ReSetOUTPort(Card,Item: Byte);

Function ReadCD(Index: Byte): Byte;
Procedure WriteCD(Index,Bin : Byte);

Procedure ReSetStream(Var Stream: StreamRec);
Function Dkv( V: Double; Item: Byte): LongInt;
Procedure Freq(f: Word);

Function GetButton(n: Byte): ShortInt;
Function GetSwitch(n: Byte): Byte;
Function GetLamp (n: Byte): Byte;
Procedure PutLamp(n,k: Byte);

Procedure Debug;

End;

{-----------------------------------------------------------------------}
IMPLEMENTATION
{-----------------------------------------------------------------------}

Uses Crt;
.........................
.........................
.........................
.........................
{---------------------------- DEBUG BODY -------------------------------}

Begin

for i:=1 to iA do if Axis[i]^.Setter then
begin Send.Next:=29; Exit; end;
RGS[4]:=ff;

TextAttr:=$0; ClrScr;
Frame(20,9,59,16,$4F,$40,$40,1,' Џ а®«м ');
WriteChar(21,13,38,HL1);
TextAttr:=$47; PS:=$0F27; Write('Esc');
S:=''; RGS[7]:=0;

With Strings do
if ((PassWord ='') or StrRead(22,12,57,$40,0,2,ProcNIL,S)) then
if S =Password then
begin

SubCh:=NUL; CRD:=1; RunTimeError.Last:=ff;
repeat
if SubCh =NUL then ViewMenu;
if KeyPressed then
begin
ChMain:=ReadKey;
if ChMain =NUL then
begin
SubCh :=ReadKey;
Case SubCh of
F1,
AltF1: Inform(SubCh <>F1);
F2: DebugSetUp;
F3: DebugIO;
F4: DebugDAC;
F5: DebugPCL;
F6: if RGS[1]> 0 then DebugMOV;
F9: ReSetStream(RunTimeError);
end;
end;
end;

ViewError;
until SubCh =#45;
end else Beep;

FillD(ARing^.Stack.D); RGS[4]:=0;
End;

{-----------------------------------------------------------------------}

End.

 - модуль редактирования УП.

{$A-,B-,D+,E-,F-,G-,I-,L-,N+,P-,Q-,R+,S+,T-,V-,X-,Y-}
{$M 16384,0}

Unit Edit;

{-----------------------------------------------------------------------}
INTERFACE
{-----------------------------------------------------------------------}

Uses Types,Dos,Screen;
{...................................................}

Type {--------------------------------------------------------------}

TEdit = object(TScreen)

public {---------------------------------------------------}

StrSize,
StackSize,
MaxBlock,
StrBlock,
StackBlock,
MaxStr,
MaxStack,
ValueStr: LongInt;

ESE : LongInt;
Strings : StringRec;
Dir : ListArr;
Split : SplitRec;
Search : SearchRec;

HoldAxis: AxisArr;
HoldM : MRec;
PrgState: Byte;
SendDis : DisRec;

fNote,
fStory : NoteFile;
Note : NoteRec;
ModeStr : array[0..Max_Mode] of String[4];

{...........................................................}

Procedure ScrollStr(var U: StrPtr; Count: LongInt);
Procedure InsertStr(U: StrPtr; Count: LongInt);
Procedure DeleteStr(U: StrPtr; Count: LongInt);
Procedure ReadNote(FileItem: Byte);

Procedure Edit;
{...........................................................}

private {------------------------------------------------}

{...................................................}

end;
{-----------------------------------------------------------------------}
IMPLEMENTATION
{-----------------------------------------------------------------------}

Uses Crt,Graph;
{...................................................}

Const {------------------------------------------------------------}

FileCache = 'CACHE.TMP';
.........................
.........................
.........................
.........................
 {..................................................................}



Bottom: Until SubCh=#45;

SubCh:=NUL; if Safe =LightCyan then begin SaveOut; Case SubCh of
YES: begin DoSave; if Safe <>White then Goto BOTTOM; end;
ESC: Goto BOTTOM; end; end;

if PrgState =0 then DeleteStr(Ring,ValueStr);
Correction:=True;
SetCursor(NotCurs);
UStart:=ARing; RGS[7]:=0;

end;
End;

{-----------------------------------------------------------------------}

End.

 - Это Очень важный модуль, в котором объявляются все Типы, Константы, коды клавиш - используемые в Системе.

 Unit Types;

{-----------------------------------------------------------------------}
INTERFACE
{-----------------------------------------------------------------------}

Const {--------------------------------------------------------------}

Hz = 500;
Hz0 = 50;

Max_RGS = 15;
Max_Axis = 5;
S_coord = 1;

Max_Box = 2;
Max_Dis = 8;
Max_Mode = 15;

Max_AStack = 5;
{....................................................}

Max_Error = 199;
Max_Message = 99;
{....................................................}

eps = 1e-3;
psi = 1e-6;
ff = $ff;
grad = 180/Pi;
{....................................................}

MaxCountShar= 12;

MaxCountCLS = 128;
MaxCountLAB = 255;

MaxLevelCLS = 5;
MaxLevelRPT = 3;

MaxBaseVar = 100;
MaxCountVar = 199;

MaxCountUAO = 99;
MaxCountDL = 99;
MaxCountGF = 99;

MaxValueUAO = 10000-psi;
MaxValueDL = 10000-psi;
MaxValueTMR = 99;
MaxValueCOL = 8;

MaxDirList = 99;
MaxFileList = 199;
MaxList = MaxDirList+MaxFileList;
{.............................................................}

MaxBufMDI = 16;
MaxPic = 8;
{....................................................}

MaxCharISO = 23;
MaxCharG = 4;
MaxCharM = 3;
{....................................................}

Max_ProcM = 99;
Max_ProcH = 99;
HFunction = Max_ProcM+1;

Max_DACCard = 1;
Max_PCLCard = 2;
Max_INPCard = 3;
Max_OUTCard = 1;

MaxDACCanals = 6;
MaxDrvCanals = 3;

MaxTableIO =
(Max_INPCard+Max_OUTCard)*MaxDrvCanals*8;
{......................................................................}

Max_Button = 12;
Max_Switch = 12;
Max_Lamp = 12;
Max_Wheel = 3;
Max_SwitchCanal = 5;
{......................................................................}

MaxHelpCatalog = 255;
MaxHelpPage = 15;

MaxWriteNote = 5000;
MaxScrew = 500;
{......................................................................}

NUL =#0; DIG = #58;
BIP =#7; NO = #78;
TAB =#9; YES = #89;
ENT =#13; HL1 =#196;
ESC =#27; HL2 =#205;
SEL =#32; RAD =#251;
TXT =#39; LAB =#254;

F1 =#59; AltF1 =#104; CrlF1 =#94;
F2 =#60; AltF2 =#105; CrlF2 =#95;
F3 =#61; AltF3 =#106; CrlF3 =#96;
F4 =#62; AltF4 =#107; CrlF4 =#97;
F5 =#63; AltF5 =#108; CrlF5 =#98;
F6 =#64; AltF6 =#109; CrlF6 =#99;
F7 =#65; AltF7 =#110; CrlF7 =#100;
F8 =#66; AltF8 =#111; CrlF8 =#101;
F9 =#67; AltF9 =#112; CrlF9 =#102;
F10=#68; AltF10=#113; CrlF10=#103;

Type {--------------------------------------------------------------}

Proc = procedure;
{.........................................................}

PtrByte = ^Byte;
PtrWord = ^Word;
PtrLong = ^LongInt;
PtrReal = ^Double;
{.........................................................}

PtrCom = ^ComStr;
ComStr = String[127];

PtrPath = ^PathStr;
PathStr = String[79];

PtrHelp = ^HelpStr;
HelpStr = String[75];

.........................
.........................
.........................
.........................

{-----------------------------------------------------------------------}
IMPLEMENTATION
{-----------------------------------------------------------------------}

{$L NVSKEY.OBJ}
{$F+}

Procedure nskSetMode(dwFlags:longint; bProg:byte; dwID:longint;
wSN:integer; bVer:byte; wMask, wType:integer ); external;

Function nskCheck( dwPrivateRD:longint ):integer; external;

Function nskRead( dwPrivateRD:longint; bAddr,bLng:byte;
pData:pointer ):integer; external;

Function nskWrite( dwPrivateWR:longint; bAddr,bLng:byte;
pData:pointer ):integer; external;

{$F-}

{-----------------------------------------------------------------------}

Const

s: RamArr =(10372477,45724409,34831329,12231437,
29912290,34471671,22432230,65438851);
c: RamArr =(1210228290,1443890225,-1202607352,-99643905,
287366910,-40468025,5864611,-36253506);


{.....................................................................}

Begin

{.....................................................................}
{Off Stels ***}

Row:=Pred(SizeOf(RamArr) div SizeOf(LongInt)); exit;
{.....................................................................}

for Row:=0 to 3 do s[Row]:=s[Row] xor s[Row+4];
for Row:=4 to 7 do s[Row]:=s[Row] xor s[Pred(Row)];
for Row:=0 to 6 do
if Odd(Row) then Inc(s[Row],s[Succ(Row)])
else Dec(s[Row],s[Succ(Row)]);

nskSetMode($3F,s[3]+c[3],s[4]+c[4],s[5]+c[5],s[6]+c[6],s[7]+c[7],0);
if nskCheck(s[0]+c[0])> 0 then repeat until False;

Row:=nskRead(s[0]+c[0],$60,$20,@c);
for Row:=0 to 7 do s[Row]:=not s[Row];
for Row:=0 to 7 do if s[Row] <>c[Row] then Break;

{-----------------------------------------------------------------------}


End.

- модуль, отвечаемый за отрисовку УП.

 Unit Screen;

{-----------------------------------------------------------------------}
INTERFACE
{-----------------------------------------------------------------------}

Uses Types,Compile;

Type {--------------------------------------------------------------}

TScreen = object(TCompile)

public {--------------------------------------------------}

ChangeCurs,
NormalCurs,
BigCurs,
NotCurs,
Cursor : Word;

EFormat,
MaxEFormat: Byte;
{...................................................}

KeyBoard : KeyArr;

ProcNIL : Proc;
WXStrRead : Byte;

Video : PtrVideo;
StrLow : PtrRowC80;
{...................................................}

Help : HelpRec;
S32 : PathStr;

Lim : DLimRec;
SLim : PathStr;
{...............................................................}

Procedure SetCursor(CursorTyp : Word);
Procedure Place(X,Y : Byte);
Procedure Beep;
Function LeftJust
(var Sourse; Size,Width,Decimals,Mode: ShortInt): PathStr;
Function DelSEL(S: String): String;
Procedure WriteChar(X,Y: Byte; Count: Word; C: Char);
Procedure Frame
(X0,Y0,X1,Y1,aText,aBord,aFild,Line: Byte; Titul: PathStr);
Function StrRead
(X0,Y0,X1,Attr,MaxLen,UC: Byte;
VirtualProc: Proc; Var S: String): Boolean;
Function GetDigitCode
(X,Y,L,Attr,Typ: Byte; S: String;
var Limits: DLimRec): Boolean;
Procedure Inform(PageMode: Boolean);
Procedure ViewClock;
Function Angle(x,y : Double): Double;
Procedure FillD(var D: AxisArr);
Procedure SetUp(Page: Byte);

{...............................................................}

end;
.........................
.........................
.........................
.........................

 {...............................................................}

#30: if Page =0 then
begin FillD(TableUAO[Item]^); PredItem:=-1; end;
#31: begin
case Page of
0: TableUAO[Item]^:=TableUAO[0]^;
1: TableDL[Item]^:=TableDL[0]^;
2: With Aring^.Stack do With EVar do
begin
if Item <10 then ELong[Item]:=0
else EDouble[Item]:=0;
if Item =Long then ViewLightLine;
end;
end;
PredItem:=-1;
end;
{...............................................................}

#15: begin
if Page> 0 then Dec(Page) else Page:=MaxPage;
ViewSet;
end;
{...............................................................}

end;
end;
TAB: begin
if Page <MaxPage then Inc(Page) else Page:=0;
ViewSet;
end;
end;
end;
{...............................................................}

until ChMain =ESC;
SubCh:=NUL; RGS[7]:=0;

End;

{-----------------------------------------------------------------------}

End.

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

Unit Picture;

{-----------------------------------------------------------------------}
INTERFACE
{-----------------------------------------------------------------------}

Procedure Menu;

{-----------------------------------------------------------------------}
IMPLEMENTATION
{-----------------------------------------------------------------------}

Uses Crt,Types,Base;

Var {--------------------------------------------------------------}

i: Integer;
s: String[8];
{................................................}

{-----------------------------------------------------------------------}

Procedure RightPanel;
Var i,Y: Byte;

Begin
With Sys do
begin
RGS[12]:=RGS[12] and 3;
for i:=5 to 21 do begin Place(45,i); Write(SEL:33); end;
TextAttr:=$0F; Place(71,3); Write(Succ(RGS[12]));
Case RGS[12] Of
0: begin
WriteChar(71, 3,1,'1');
WriteChar(46,19,1,'D');
WriteChar(65,19,1,'L');
WriteChar(46,20,1,'G');
WriteChar(46,21,1,'M');
TextAttr:=$07;
WriteChar(45,9,33,HL1);
WriteChar(45,18,33,HL1);
Place(46,5); Write('FQC');
Place(61,5); Write('USB');
Place(70,5); Write('TMR');
Place(46,6); Write('FWC');
Place(61,6); Write('URL');
Place(70,6); Write('UTS');
Place(46,7); Write('FVR');
Place(61,7); Write('UVR');
Place(70,7); Write('USO');
Place(46,8); Write('JOG');
Place(61,8); Write('UCV');
Place(70,8); Write('UAO');
Place(46,12); Write('Џа®Ја ¬¬ ');
Place(46,13); Write('Џ®¤Їа®Ја ¬¬ ');
Place(46,14); Write('–ЁЄ« RPT');
Place(46,15); Write('‚ᥣ® Є ¤а®ў');
Place(46,16); Write('’ҐЄгйЁ© Є ¤а');
RGS[9]:=0;
end;
2: begin
TextAttr:=$07;
Place(46,5); Write('‚室­лҐ бЁЈ­ «л:');
Y:=7;
for i:=1 to nINPCard do
begin
Place(46,Y);
TextAttr:=$0F; Write(i);
TextAttr:=$02; Write(' 01234567 ');
TextAttr:=$06; Write('01234567 ');
TextAttr:=$04; Write('01234567 ');
Inc(Y,2);
end;
TextAttr:=$07;
Place(46,Succ(Y)); Write('‚л室­лҐ бЁЈ­ «л:');
Inc(Y,3);
for i:=1 to nOUTCard do
begin
Place(46,Y);
TextAttr:=$0F; Write(i);
TextAttr:=$02; Write(' 01234567 ');
TextAttr:=$06; Write('01234567 ');
TextAttr:=$04; Write('01234567 ');
Inc(Y,2);
end;
end;
end; {Case}
RGS[8]:=0;
end; {Sys}
End;
.........................
.........................
.........................
.........................
{-----------------------------------------------------------------------}
{ INIT }
{-----------------------------------------------------------------------}

Begin
With Sys do
begin

UserView:=View;
{.......................................................}

end;

{-----------------------------------------------------------------------}


End.

Uses Crt;
Var
 C0,C1: Char;
Begin
 TextAttr:=$07; ClrScr;
 Repeat
  C0:=ReadKey;
  if C0 =#0 then C1:=ReadKey;
  WriteLn(C0:4,Ord(C0):6,' ':10,C1:4,Ord(C1):6);
 until C0 =#27;
End.

Uses Crt,Types;
Var
  c: Char;
begin

 repeat
  if KeyPressed then C:=ReadKey;
  WriteLn(ExtendKey:8,StatusKey:8);
 until C =ESC;

end.

 Uses Crt,Types;

Const {.................................................}

Error0 ='ЋиЁЎЄ  ®вЄалвЁп д ©«  ';
Error1 ='ЋиЁЎЄ  § ЇЁбЁ ў д ©« ';

MaxPage = MaxHelpPage;
MaxStr = Pred(SizeOf(HelpStr));
CharStr = Char(MaxStr);

Var {...................................................}

fIn : Text;
FOut: File Of HelpPageArr;
Page: HelpPageArr;
S: String;
Name: ShortStr;
Item: Byte;
i,L : Byte;
.........................
.........................
.........................
.........................
 Write('‡ ЇЁб ­® ',FileSize(fOut),' бва ­Ёж(л).');
Close(fIn); Close(fOut);

End.

Uses Types,Crt;

Var 
 f: File of NoteRec;
 Note: NoteRec;

Begin

{$I+}

 ClrScr;
 Assign(f,'NOTE.INF'); ReWrite(f); Close(f);
 Assign(f,'STORY.INF'); ReWrite(f); Close(f);

{$I-}

End.