К сожалению, макрос отображается не совсем правильно из-за присутствия в нем ДОС-символов псевдографики, а переделывать на Юникод некогда
$MACRO LINEDRAW TRANS;
{ This macro allows the user to draw the single and double line characters
using the arrow keys to create lines and boxes etc. }
{ Define variables }
Def_Char(U_Char,D_Char,L_Char,R_Char);
Def_Int(Temp_Integer,Present_Direction,A_Left,A_Right,A_Up,A_Down,
Mode,Temp_Insert,D_Mode,U_Mode,L_Mode,R_Mode);
{ Store current status of certain stuff so we can restore it upon exit. }
Temp_Insert := INSERT_MODE;
Insert_Mode := False;
Undo_Stat := False;
Push_Labels;
{ Initialize variables }
Present_Direction := 0;
A_Left := 1;
A_Right := 2;
A_Up := 3;
A_Down := 4;
Mode := 1;
MAKE_MESSAGE('SINGLE LINE: |26 = move, Shift |26 = draw, F2 = О, Esc = quit.');
FLABEL('Double',2,$FF);
{
FLABEL('Box',3,$FF);
}
Goto WAIT_FOR_KEYPRESS;
GO_LEFT:
Left;
WAIT_FOR_KEYPRESS:
READ_KEY;
Insert_Mode := False;
GET_KEY_CODES:
If (KEY1 = 27) Then
Clr_Line(1,2,80);
Goto END_OF_MAC; { If so, then user hit <ESC> so...}
End;
IF KEY2 = 59 THEN
Help('LD');
END;
IF KEY2 = 60 THEN
IF (Mode < 3) THEN
Mode := Mode + 1;
End
Else
Mode := 1;
END;
MAKE_MESSAGE(Copy(
'SINGLE LINE: |26 = move, Shift |26 = draw, F2 = О, Esc = quit. DOUBLE LINE: |26 = move, Shift |26 = draw, F2 = erase, Esc = quit.ERASE: |26 = move, Shift |26 = erase, F2 = Е, Esc = quit. '
,((Mode - 1) * 68) + 1,68));
FLABEL(Copy('DoubleErase Single',((Mode - 1) * 6) + 1,6),2,$FF);
Goto WAIT_FOR_KEYPRESS;
END;
IF (KEY2 = 73) THEN
Page_Up;
End;
IF (KEY2 = 81) THEN
Page_Down;
End;
IF (KEY2 = 71) THEN
Home;
End;
IF (KEY2 = 79) THEN
Eol;
End;
{
IF KEY2 = 61 THEN
Run_Macro('BOX','');
End;
}
IF (KEY2 = 77) Then {Right arrow}
If C_Col > 252 Then {Don't allow cursor to wrap down}
Goto WAIT_FOR_KEYPRESS;
End;
If (KEY1 = 0) Then {If unshifted, then move right}
Right;
Present_Direction := 0;
Goto WAIT_FOR_KEYPRESS;
END;
If KEY1 = 54 then {If shifted, then insert the appropriate char}
IF (Mode = 3) THEN
Text(' ');
Present_Direction := 0;
Goto WAIT_FOR_KEYPRESS;
END;
If Present_Direction = A_Right Then {If we were previously going a
different direction, then insert char at current cusror position. Otherwise,
insert char in the next right position}
Right;
End;
Present_Direction := A_Right;
Call LOOK_AROUND;
Temp_Integer := XPos(L_Char,'ї·ё»ЩѕЅјґ¶№µ',1);
If (Temp_Integer) Then
Left;
Text(Copy('ВТВТББРРЕЧЧЕЛЛСЛКПККОООШ',((Mode - 1) * 12) + Temp_Integer,1));
Goto GO_LEFT;
End;
If ((L_Mode > 0) and ((D_Mode + U_Mode + R_Mode) = 0)) Then
Text(Copy('ДН',Mode,1));
Goto GO_LEFT;
End;
If ((D_Mode = 1) And (U_Mode = 1)) Then
Text(Copy('ГЖГЖЖМГЖґ№ЕОґ№ГЖµµµµШО',((L_Mode * 8) + (R_Mode * 2)) + Mode,1));
Goto GO_LEFT;
End;
If ((D_Mode = 2) And (U_Mode = 2)) Then
Text(Copy('ЗМЗМЗМЗМ¶№ЧОЗМЗМґ№ґ№ЕО',((L_Mode * 8) + (R_Mode * 2)) + Mode,1));
Goto GO_LEFT;
End;
If (D_Mode = 1) Then
Text(Copy('ЪХЪХїёЪХї»ВЛї»ЪХїёЪХВС',((L_Mode * 8) + (R_Mode * 2)) + Mode,1));
Goto GO_LEFT;
End;
If (D_Mode = 2) Then
Text(Copy('ЦЙЦЙЦЙЦЙ·»ТЛ·»ЦЙ·»ЦЙТЛ',((L_Mode * 8) + (R_Mode * 2)) + Mode,1));
Goto GO_LEFT;
End;
If (U_Mode = 2) Then
Text(Copy('УИУИУИУИЅјРКЅјУИЅјУИРК',((L_Mode * 8) + (R_Mode * 2)) + Mode,1));
Goto GO_LEFT;
End;
If (U_Mode = 1) Then
Text(Copy('АФАФЩѕАФЩјБКЩјАФЩѕАФБП',((L_Mode * 8) + (R_Mode * 2)) + Mode,1));
Goto GO_LEFT;
End;
{If no other condition exists...}
Text(Copy('ДН',Mode,1));
Goto GO_LEFT;
END;
END;
IF (KEY2 = 75) Then {Left arrow}
If C_Col = 1 Then {Don't allow cursor to wrap up}
Goto WAIT_FOR_KEYPRESS;
End;
If (KEY1 = 0) Then {If unshifted, then move left}
Left;
Present_Direction := 0;
Goto WAIT_FOR_KEYPRESS;
END;
If KEY1 = 52 then {If shifted, then insert the appropriate char}
IF (Mode = 3) THEN
Text(' ');
Left;
Left;
Present_Direction := 0;
Goto WAIT_FOR_KEYPRESS;
END;
If Present_Direction = A_Left Then {If we were previously going a
different direction, then insert char at current cusror position. Otherwise,
insert char in the next left position}
Left;
End;
Present_Direction := A_Left;
Call LOOK_AROUND;
Temp_Integer := XPos(R_Char,'ЪЦХЙАФУИГЗМЖ',1);
If (Temp_Integer) Then
Right;
Text(Copy('ВТВТББРРЕЧЧЕЛЛСЛКПККОООШ',((Mode - 1) * 12) + Temp_Integer,1));
Goto GO_LEFT;
End;
If ((R_Mode > 0) and ((D_Mode + U_Mode + L_Mode) = 0)) Then
Text(Copy('ДН',Mode,1));
Goto GO_LEFT;
End;
If ((D_Mode = 1) And (U_Mode = 1)) Then
Text(Copy('ґµГМЖЖґµґµЕОґµґµµ№ГМШО',((L_Mode * 8) + (R_Mode * 2)) + Mode,1));
Goto GO_LEFT;
End;
If ((D_Mode = 2) And (U_Mode = 2)) Then
Text(Copy('¶№ЗМГМ¶№¶№ЧОГМ¶№¶№¶№ЕО',((L_Mode * 8) + (R_Mode * 2)) + Mode,1));
Goto GO_LEFT;
End;
If (D_Mode = 1) Then
Text(Copy('їёЪЙЪХїёїёВЛїёїёЪХЪЙВС',((L_Mode * 8) + (R_Mode * 2)) + Mode,1));
Goto GO_LEFT;
End;
If (D_Mode = 2) Then
Text(Copy('·»ЦЙЦЙ·»·»ТЛ·»·»·»ЦЙТЛ',((L_Mode * 8) + (R_Mode * 2)) + Mode,1));
Goto GO_LEFT;
End;
If (U_Mode = 2) Then
Text(Copy('ЅјУИУИЅјЅјРКЅјЅјЅјУИРК',((L_Mode * 8) + (R_Mode * 2)) + Mode,1));
Goto GO_LEFT;
End;
If (U_Mode = 1) Then
Text(Copy('ЩѕАИАФЩѕЩѕБКЩѕЩѕЩѕАИБП',((L_Mode * 8) + (R_Mode * 2)) + Mode,1));
Goto GO_LEFT;
End;
{If no other condition exists...}
Text(Copy('ДН',Mode,1));
Goto GO_LEFT;
END;
END;
IF (KEY2 = 72) Then {Up arrow}
If C_Line = 1 Then
Goto WAIT_FOR_KEYPRESS;
End;
If (KEY1 = 0) Then {If unshifted, then move left}
Up;
Present_Direction := 0;
Goto WAIT_FOR_KEYPRESS;
END;
If KEY1 = 56 then {If shifted, then insert the appropriate char}
IF (Mode = 3) THEN
Text(' ');
Left;
Up;
Present_Direction := 0;
Goto WAIT_FOR_KEYPRESS;
END;
If Present_Direction = A_Up Then {If we were previously going a
different direction, then insert char at current cusror position. Otherwise,
insert char in the next left position}
Up;
End;
Present_Direction := A_Up;
Call LOOK_AROUND;
Temp_Integer := XPos(D_Char,'їё·»ЪЦХЙВСЛТ',1);
If (Temp_Integer) Then
Down;
Text(Copy('ґµґµГГЖЖЕШШЕ№№¶№МЗММОООЧ',((Mode - 1) * 12) + Temp_Integer,1));
Goto GO_LEFT;
End;
If ((D_Mode > 0) and ((R_Mode + U_Mode + L_Mode) = 0)) Then
Text(Copy('іє',Mode,1));
Goto GO_LEFT;
End;
If ((L_Mode = 1) And (R_Mode = 1)) Then
Text(Copy('БРВЛТТБРБРЕОБРБРРКВЛЧО',((U_Mode * 8) + (D_Mode * 2)) + Mode,1));
Goto GO_LEFT;
End;
If ((L_Mode = 2) And (R_Mode = 2)) Then
Text(Copy('ПКСЛВЛПКПКШОВЛПКПКПКЕО',((U_Mode * 8) + (D_Mode * 2)) + Mode,1));
Goto GO_LEFT;
End;
If (L_Mode = 1) Then
Text(Copy('ЩЅї»ї·ЩЅЩЅґ№ЩЅЩЅЩЅї»ґ¶',((U_Mode * 8) + (D_Mode * 2)) + Mode,1));
Goto GO_LEFT;
End;
If (L_Mode = 2) Then
Text(Copy('ѕјё»ё»ѕјѕјµ№ѕјѕјѕјё»µ№',((U_Mode * 8) + (D_Mode * 2)) + Mode,1));
Goto GO_LEFT;
End;
If (R_Mode = 2) Then
Text(Copy('ФИХЙХЙФИФИЖМФИФИФИХЙЖМ',((U_Mode * 8) + (D_Mode * 2)) + Mode,1));
Goto GO_LEFT;
End;
If (R_Mode = 1) Then
Text(Copy('АУЪЙЪЦАУАУГМАУАУАУЪЙГЗ',((U_Mode * 8) + (D_Mode * 2)) + Mode,1));
Goto GO_LEFT;
End;
{If no other condition exists...}
Text(Copy('іє',Mode,1));
Goto GO_LEFT;
END;
END;
IF (KEY2 = 80) Then {Down arrow}
If (KEY1 = 0) Then {If unshifted, then move right}
Down;
Present_Direction := 0;
Goto WAIT_FOR_KEYPRESS;
END;
If KEY1 = 50 then {If shifted, then insert the appropriate char}
IF (Mode = 3) THEN
Text(' ');
Left;
Down;
Present_Direction := 0;
Goto WAIT_FOR_KEYPRESS;
END;
If Present_Direction = A_Down Then {If we were previously going a
different direction, then insert char at current cusror position. Otherwise,
insert char in the next right position}
Down;
End;
Present_Direction := A_Down;
Call LOOK_AROUND;
Temp_Integer := XPos(U_Char,'ЩѕЅјАУФИБПКР',1);
If (Temp_Integer) Then
Up;
Text(Copy('ґµґµГГЖЖЕШШЕ№№¶№МЗММОООЧ',((Mode - 1) * 12) + Temp_Integer,1));
Goto GO_LEFT;
End;
If ((U_Mode > 0) and ((R_Mode + D_Mode + L_Mode) = 0)) Then
Text(Copy('іє',Mode,1));
Goto GO_LEFT;
End;
If ((L_Mode = 1) And (R_Mode = 1)) Then
Text(Copy('ВТВТТЛВТБКЕОБКВТРРВТЧО',((U_Mode * 8) + (D_Mode * 2)) + Mode,1));
Goto GO_LEFT;
End;
If ((L_Mode = 2) And (R_Mode = 2)) Then
Text(Copy('СЛСЛСЛСЛПКШОСЛСЛБКБКЕО',((U_Mode * 8) + (D_Mode * 2)) + Mode,1));
Goto GO_LEFT;
End;
If (L_Mode = 1) Then
Text(Copy('ї·ї·ї·ї·Щјґ№Щјї·ЩЅї·ґ¶',((U_Mode * 8) + (D_Mode * 2)) + Mode,1));
Goto GO_LEFT;
End;
If (L_Mode = 2) Then
Text(Copy('ё»ё»ё»ё»ѕјµ№ѕјё»ѕјё»µ№',((U_Mode * 8) + (D_Mode * 2)) + Mode,1));
Goto GO_LEFT;
End;
If (R_Mode = 2) Then
Text(Copy('ХЙХЙХЙХЙФИЖМФИХЙФИХЙЖМ',((U_Mode * 8) + (D_Mode * 2)) + Mode,1));
Goto GO_LEFT;
End;
If (R_Mode = 1) Then
Text(Copy('ЪЦЪЦЪЦЪЦАИГМАИЪЦАУЪЦГЗ',((U_Mode * 8) + (D_Mode * 2)) + Mode,1));
Goto GO_LEFT;
End;
{If no other condition exists...}
Text(Copy('іє',Mode,1));
Goto GO_LEFT;
END;
END;
{*****************************************************************************}
Goto WAIT_FOR_KEYPRESS;
LOOK_AROUND:
{ This subroutine looks at all chars surrounding CUR_CHAR and stores them into
variables }
If (((C_Row + 2) > Win_Y1) And ((C_Row + 4) < Win_Y2)) Then
Refresh := False;
End;
If C_Line > 1 Then
UP;
U_Char := Cur_Char;
RIGHT;
DOWN;
End
Else
U_Char := '|0';
Right;
End;
R_Char := Cur_Char;
DOWN;
LEFT;
D_Char := Cur_Char;
If C_COL > 1 Then
LEFT;
UP;
L_Char := Cur_Char;
RIGHT;
End
Else
L_Char := '|0';
Up;
End;
Refresh := True;
D_mode := XPos(D_Char,'іЕБГґАЩєОКМ№Иј',1);
D_mode := (D_Mode > 0) + (D_Mode > 7);
U_mode := XPos(U_Char,'іЕВГґЪїєОЛМ№Й»',1);
U_mode := (U_Mode > 0) + (U_Mode > 7);
L_mode := XPos(L_Char,'ЕБГАДЪВОКМИНЙЛ',1);
L_mode := (L_Mode > 0) + (L_Mode > 7);
R_mode := XPos(R_Char,'ЕБґїДЩВОК№»НјЛ',1);
R_mode := (R_Mode > 0) + (R_Mode > 7);
RET;
END_OF_MAC:
INSERT_MODE := Temp_Insert; { Switch previous insert/overwrite mode }
Pop_Labels;
Undo_Stat := True;
END_MACRO;