Секция 2 из 2 - Предыдущая - Следующая
ФУНКЦИЯ ORDER: Даёт следующее/предыдущее значение индексов в массиве на
данном уровне. Массивы-то ведь разрежённые!;)
КОМАНДЫ: Могут сокращаться до первой буквы.
DO label(arg1,arg2,arg3) вызывает подпрограмму
ELSE stmnt1 stmnt2 stmnt3 условие ИНАЧЕ
FOR stmnt1 stmnt2 stmnt3 бесконечный цикл
FOR i=1:2:100 stmnt1 ... цикл, i=1, 3, 5, ... 99
GOTO label да, он здесь есть :-)
HALT заканчивает задание
HANG sec задержка выполнения в сек.
JOB label запускает задание-потомок
IF cnd stmnt1 stmnt2 stmnt3 условие ЕСЛИ
KILL vbl уничтожает определение переменной
LOCK vbl логическая блокировка переменной
NEW vbl1,vbl2,vbl3 кладёт переменные в стек
QUIT value возврат из подпрограммы
READ "Prompt:",x ввод с текущего устройства
SET a=22,name="Dan",(c,d)=0 присвоение переменной значения
OPEN 1 открывает устройство 1 для ввода/вывода
USE 23 переключает ввод/вывод на устройство 23
CLOSE 51 закрывает устройство 51
WRITE !,"x=",x ввыводит на текущее устройство
! = новая строка
XECUTE("set a=5 do xyz") исполняет данные как M программу
ОПРЕАТОРЫ: Приоритетов нет, только слева направо. Скобки работают.
2+3*10 = 50
+ - * / складывание, вычитание, умножение, деление
\ целочисленное деление, 1234\10 = 123
# остаток
_ слияние строк, "nice"_2_"use" --> "nice2use"
& ! ' < > и, или, не, меньше, больше, равно
Примечание: ' может комбинироваться с др. операциями
[ строка содержит. "ABCD"["BC" --> истина
] строка лексически следует за. "Z"]"A" --> истина
? шаблоны
** возведение в степень
]] строка следует за (в числовом порядке)
ВСТРОЕННЫЕ ФУНКЦИИ:
Важные структурные части языка (обычно отстутствующие в других языках):
$DATA(V) проверка, определена или нет переменная V
$GET(V) выдаёт значение переменной либо пусто
(если она не определена)
$ORDER, $QUERY проходит индексы массива по порядку
$PIECE см. выше
$SELECT(c1:v1,c2:v2,1:v3) оператор выбора-проверка идёт по порядку
$TEXT(FOO+3) возвращает строку исходного текста FOO+3
Обычные функции, сходные с другими языками:
$ASCII, $CHAR преобразование символа в ASCII и наоборот
$EXTRACT(string,5,10) выделение подстроки
$FIND(string,find,from) поиск подстроки
$FNUMBER форматирование чисел с плавающей точкой
$JUSTIFY(vbl,len{,pnt}) выравнивание по левому краю
$LENGTH(string{,sep}) длина строки, также число полей в строке
$RANDOM(100) генератор псевдослучайных чисел
$TRANSLATE("abcd","ab","AB")подстановка значений; вернёт "ABcd"
СИСТЕМНЫЕ ПЕРЕМЕННЫЕ (фактически функции без параметров):
$H текущее системное время
$IO текущее устройство
$JOB номер текущего задания в системе
$STORAGE количество свободного ОЗУ у задания
$TEST результат логической операции IF,
также состояние после Read,Job,Open
$X текущая колонка вывода
$Y текущая строка вывода
$ZE код ошибки в программе
$ZR полная ссылка к последнему запрошенному
индексу массива
$ZT ссылка на обработчик ошибок
------------------------------------------------------------------------
Приложение 1a: Типичные ошибки начинающих программистов в призме советов.
1) Помните, что разбор всё время идёт слева направо: приоритетов нет, если
только Вы не поставили скобки.
2) Не надо стараться писать всё в одну строку. Впрочем также не надо
стараться писать по одной команде на строке;). Идеалом считается программа,
занимающая квадрат 80х25.
3) Комментарии допустимы, но не надо ими злоупотреблять. Рекомендуется
ставить их на конце строк, перед точками входа в подпрограмм и функции и
не делать строчек только с комментариями, но без команд, если эти
строчки будут выполняться. Примеры:
лучше
;вводный комментарий о п/п
label(pars)
s a=0 ;начальные присвоения
...
q
хуже
label(pars)
;вводный комментарий о п/п
...
;начальные присвоения
s a=0
...
q
btw, пустые строки(без кода) допустимы, но для ГАРАНТИРОВАННОЙ работы
программы я могу посоветовать всё-таки ставить там ";" - поскольку
ранее существовало соглашение о конце программы по пустой строке.
4) Избегайте чрезмерного размножения глобальных переменных. Помните, что
один глобаль со множеством уровней индексов гораздо эффективнее множества
глобалей с одним уровнем индекса. Т.е. ^global(0,1,4,2) лучше ^g(0),^h(1),
^k(4),^l(2).
5) Помните, что индексы могут быть любые и идти не по порядку, т.е.
допустимо:
^gl(2)=1
^gl(45)=51
^gl("ну я не знаю что")="?"
6) Лучше давать имена покороче, хотя это и не обязательно. НО! MSM и DSM
различают только первые 8 знаков имени переменной.
7) Помните, что индексы, как правило, здесь упорядочиваются так: сначала
числа, затем все остальные в лексикографическом порядке.
8) Относительно так называемых "постусловий" - их правильней называть
"пред-условиями", т.к. они вычисляются перед выполнением соответствующей
команды и т.о. влияют на её выполнение/невыполнение. НО! эти условия никоим
образом не влияют на выполнение других команд или частей данной команды:
set e="" for set e=$o(^gl(e)) quit:e="" write e,! ;вывод индексов в gl
остаток строки после quit при невыполнении e="" не игнорируется.
фактически можно было бы записать (с усложнением) тоже самое так:
set e="" for do if e="" quit
.set e=$o(^gl(e))
.i e="" quit
.write e,!
Побочным следствием этого является то, что если в команде перехода/вызова
предыдущий оператор выполнился/не выполнился, на текущий это может никак
не повлиять:
set a=1 do 1:a,2:a,3 даст результат "13".
quit
1 set a=0
write "1" quit
2 set a=0
write "2" quit
3 write "3" quit
9) В функции $Select при выполнении должно быть хотя бы одно истинное
условие. Обычно это достигается помещением условия 1 в конце тела функции
и соответсвующего действия.(наподобие default: в C)
10) Помните, что операция "=" выполняет строковое сравнение, а "<",">" -
числовое сравнение. т.е. set var="" write var=0 даст "ложь".
Для неявного приведения типов можно использовать "+":
set var=0 write +var=0 даст "истину".
11) Чтобы получить строку, состоящую из некоторого количества одинаковых
знаков, советую воспользоваться: $tr($j("",<число знаков>)," ",<нужный
знак>). Для проверки на неравенство "пусто" советую использовать:
variable]"". Впрочем никто не запрещает использовать variable'="".
12) Большую трудность для программистов, переходящих с других языков,
представляет отсутствие в явном виде оператора окончания цикла.
Как быстрое решение можно предложить использование ZT и $ZT:
Set $Zt="chkloop" For I=0:1:25 Do
.stmt1
...
.stmtN
.Zt:I=23&(F=X) "Loop" ;здесь нам надо выйти
...
More ;
...
chkloop I $ZE["Loop" G More
E ZQ
модифицированный вариант:
d endloop("lab") f d
.<...>
.zt "LooP"
.<...>
lab ;
endloop(lab) s $zt="endloop+1" q
if $ZE'["LooP" zq
goto @lab
при необходимости lab легко стекируется командой new, в новых версиях
можно использовать $Estack,$Stack и $Ecode, сохраняя $Estack где это
необходимо:
S $Es="exitloop" For Do
.<...>
.New $Es Set $Es="breakloop" For Do
..Quit:cnd
<...>
breakloop .;обработчик
Как самое простое - использование флажка типа Q:Flag. Если надо выходить с
нескольких уровней, использовать биты:
Set Flag=0
For Do Quit:$ZB(Flag,4,1)
.For Do Quit:$ZB(Flag,2,1)
..For Do Quit:$ZB(Flag,1,1)
...<...>
...If cnd Set Flag=1 Quit
..If cnd Set Flag=2 Quit
.If cnd Set Flag=4 Quit
13) В блочной структуре переменная $Test стекируется! Т.е.:
Set A=1 If A=1
Do
.I A'=1
.Write $Test,!
Write $Test,!
напечатает
0
1
------------------------------------------------------------------------
Приложение 2: Пример "книжного" программирования на M
This is based on an example from a well-known M textbook, "The Complete
MUMPS" by John Lewkowicz; the line numbers are NOT part of the M code.
1 zsample ;dpb;09:18 PM 6 Aug 1994
2
3 ;Test the Stats routine:
4 ;Calculate 1000 points w. approx. Gaussian distribution,
5 ;then call Stats on the result
6 ;Execution time: 5 seconds with DTM on a 33 MHz 386DX
7
8 New Data,i,j,output
9 For i=1:1:1000 Set Data(i)=$$Normal
10 Do Stats("Data",.output)
11 Write !,output
12 Quit
13
14 ;------------------------------------------------------------
15 ;Based on Lewkowicz, "The Complete MUMPS," examples 9.15-9.17
16 ;Modified slightly:
17 ;Used argumentless Do instead of two If's for Num>1 block
18 ;Corrected calculation of the standard error
19 ;------------------------------------------------------------
20
21 Stats(Ref,Results) ; Calculate simple Statistics on Array nodes
22 New High,i,Low,Mean,Num,StdDev,StdErr,s,Sum,SumSQ,Var
23 Set High=-1E25,Low=1E25,(Sum,SumSQ,Num)=0,s=""
24 For Set s=$O(@Ref@(s)) Q:s="" Do StatsV(@Ref@(s))
25 If 'Num Set Results="" Goto StatsX
26 Set Mean=Sum/Num
27 Set (StdDev,StdErr,Var)=""
28 If Num>1 Do
29 . Set Var=-Num*Mean*Mean+SumSQ/(Num-1)
30 . Set StdDev=$$SQroot(Var)
31 . Set StdErr=StdDev/$$SQroot(Num)
32 Set Results=Num_";"_Low_";"_High_";"_Mean
33 Set Results=Results_";"_Var_";"_StdDev_";"_StdErr
34 Goto StatsX
35 StatsV(Val) ;Process an individual value
36 Set Val=$$NumChk(Val) Quit:Val=""
37 Set Num=Num+1,Sum=Sum+Val,SumSQ=Val*Val+SumSQ
38 Set:Val<Low Low=Val Set:Val>High High=Val
39 Quit
40 StatsX Quit
41
42 SQroot(Num) ;Return the SQUARE ROOT of abs(Num)
43 New prec,Root Set Root=0 Goto SQrootX:Num=0
44 Set:Num<0 Num=-Num Set Root=$S(Num>1:Num\1,1:1/Num)
45 Set Root=$E(Root,1,$L(Root)+1\2) Set:Num'>1 Root=1/Root
46 For prec=1:1:6 Set Root=Num/Root+Root*.5
47 SQrootX Quit Root
48
49 NumChk(Data,Range,Dec) ;Check for valid NUMBER
50 Set Data=$TR(Data,"+ $,")
51 Goto NumChkE:Data'?.E1N.E,NumChkE:Data'?."-".N.".".N
52 If $D(Dec),Dec?1N.N g NumChkE:$L($P(Data,".",2))>Dec
53 Set:'$D(Range) Range="" Set:Range="" Range="-1E25:1E25"
54 If $P(Range,":")'="" Goto NumChkE:Data<$P(Range,":")
55 If $P(Range,":",2)'="" Goto NumChkE:Data>$P(Range,":",2)
56 Set Data=+Data Goto NumChkX
57 NumChkE Set Data=""
58 NumChkX Quit Data
59 ;
60 ;------------------------------------------------------------------
61 ;
62 ;Part of demo/test code, Dan Smith, 8/26/94
63 Normal() ;Return random # with approximately Gaussian distribution
64 New i,x,n ;n=# iterations
65 Set x=0,n=3 ;Higher n = slower, better Gaussian approximation
66 ;$random(1201) has approx. mean=600, variance=120000
67 For i=1:1:n*n Set x=x+$random(1201)-600
68 Set x=x/(346.4101615*n) ;variance now 1
69 Quit x
[Lines 21-58 are from Examples 9.15, 9.17 and 9.18 of "The Complete MUMPS,"
by John Lewkowicz, ISBN 0-13-162141-6, 1989, Prentice-Hall, Englewood Cliff,
New Jersey and are copyright 1989 by Prentice-Hall, Inc. Permission to use
these examples has been solicited from Prentice-Hall, but no reply has been
received. This Appendix may be modified or omitted in future versions if
Prentice-Hall objects to its inclusion].
Notes:
Line 8: Регистр команд безразличен. Т.е. NEW=New=N=n.
Команда NEW: Исполняемая команда, обычно используемая при вызовах
подпрограмм. Переменные кладутся в стек, затем, при возврате, старые
значения восстанавливаются. Хорошим стилем считается использование NEW в
подпрограммах для хранения временных параметров.
Lines 8, 10, and 21: Рассматривает ссылку на массив как аргумент.
"Stats" - подпрограмма, коия имеет список передаваемых параметров, с
помощью механизма косвенности и разыменования вырадение @Ref@(s) делает
ссылку на Data(s). Если Ref будет содержать "^Permanent", то @Ref@(s)
будет ссылаться на ^Permanent(s).
Line 28: Безаргументный DO. Эта структура обеспечивает блочность кода,
вызывая на исполнение нижележащие строчки, начинающиеся с точки. Может
быть вложенной и сохраняет переменную $TEST (состояние условия если).
If condition1 Do
. If condition2 Do
. . <code> ;выполняется если условия 1 и 2 истинны оба
. . <code>
. . <code>
. Else Do
. . <code> ;выполняется если условие 1 истинно, а 2 - ложно
. . <code>
. . <code>
Else Do
. <code> ;выполняется если условие 1 ложно
. <code>
. <code>
------------------------------------------------------------------------
Приложение 3: Пример "традиционного" программирования на M
ENTRY ;BYG;FULL-SCREEN EDITOR (C) BOKHONKOVICH YURY V01.03 04.01.96
;
B 1 S $ZT="Q" U 0:80 S K=$G(K,1)
PGNM W !,*27,"JИМЯ ПРОГРАММЫ <",$G(^FMU($I),""),">: " R FT,! S:FT=""&$D(^($I))
FT=^($I) G NOPG:FT="",NOPGM:'$D(^ (FT)) S ^FMU($I)="ZL "_FT_" S ^FMU($I,1)=1 F
LN=1:1 S ^(LN)=$T(+LN) I """"=$T(+LN) ZR Q" J ENTRY^%FMUEXEC
F RC=0:1:300 H 1 Q:^FMU($I)
I RC>299 ZM 0,21 W "НЕТ ОТВЕТА !",*7 H 2 G ABORT
S LN=^($I)-1,^($I)=FT
;G ENTRY^FMU:'$D(^FMU($IO))
OK U 0:(0::::129) W:K *27,"="
S $ZT="ERHND",(RL,UF,GF,IM,BP,BR)=0,(FLN,FCN,PC,PR)=1,S=^FMU($IO,LN+1),IC=0,IR
=1, R=S D PICKUP,RFRSH G ENTRY
NOPGM R "НОВАЯ ПРОГРАММА ? (Y/N) ",CK,! I CK="Y"!(CK="Ы") S
^FMU($I)=FT,^($I,1)=" ",^(2)="",LN=1 G OK
G NOPG
RFRSH ZM 0,0 W *27,"JПРОГРАММА: ",FT,?21,"ТЕКУЩАЯ
СТРОКА:",?42,"КОЛОНКА:",?57,"INS"
ALIENS S FLG=3 ZM 79,0 F
RC=$S(FLN+19<LN:FLN,LN>20:LN-19,1:1):1:$S(FLN+20>LN:LN,1:FLN+19) D
.W !,*27,"K" I FLN+IR-1'=RC N M,T S M=^(RC),T=$F(M," ")
.W:FCN<9 $E(M,1,T-1),$ZL(10-T," "),$E(M,T,$S($L(M)-T>69:69+T,1:$L(M)))
W:FCN>1&($L(M)-T+11>FCN) $E(M,FCN+T-10,FCN+68+T)
W *27,"J" G SM1
GETC R *CK I CK=27 R *CK G
GOLD:CK=80,HELP:CK=81,UP:CK=65,DOWN:CK=66,LEFT:CK=68,RIGHT:CK=67,SPL:CK=63&'GF,
SPLG:CK=63&GF,SPLK:CK>47&(CK<58&'GF),SPLKG:CK>47&(CK<58&GF),DELLIN:CK=59&'GF,UN
D:CK=59&GF
E G ABORT:CK=1,UNDO:CK=21,RFRSH:CK=18,NEXTWRD:CK=9,WRDBACK:CK=10,DELCHR:CK=12
7,RUBO UT:CK=8,INSLIN:CK=13,INSMOD:CK=11,INSCHR:CK>31&(CK<127)
G GETC
UND D DG G UNDELLIN
SPL R *CK
G DELLIN:CK=110,QUIT:CK=112,END:CK=113,HOME:CK=119,SEARCH:CK=120,PGUP:CK=121,P
GDN :CK=115,MARKBLK:CK=114,PASTE:CK=116,COPY:CK=117,CUT:CK=118,GETC
SPLK S CK=CK+64 G SPL+1
SPLG D DG R *CK
G EOF:CK=115,BOF:CK=121,UNDELLIN:CK=110,GOPOS:CK=119,MARKOFF:CK=114,REPLACE:CK
=12 0,MARKPOS:CK=113,CLEAR:CK=116,APPEND:CK=117,MOVE:CK=118,GETC
SPLKG S CK=CK+64 G SPLG+1
GOLD D DG G SM1
DG ZM 52,0 W:GF " " S GF='GF W:GF "GOLD" Q
INSMOD ZM 56,0 W:IM "INS" S IM='IM W:IM "OVR" G SM1
UNDO S UF=0,RL=FCN+IC D PICKUP,GETSTR S RL=0 G ALIENS
MARKPOS S PR=FLN+IR-1,PC=FCN+IC G SM1
GOPOS D SU S:FLN>PR!(FLN+19<PR) FLG=6 S
FLN=$S(PR-FLN<20&(PR>FLN):FLN,LN<21:1,PR+10>LN:LN-19,PR-10<1:1,1:PR-10),IR=PR-F
LN+1,RL=PC D PICKUP,GETSTR S RL=0 G SM
NEXTWRD G RIGHT:FCN+IC+1>LS I FCN+IC<10 S IC=9 G SM1
S SS=$L(M)+1 F CC=FCN+IC+T-5:1:$L(M) F RC=32,58,44,40,41 I $A(M,CC)=RC S
SS=CC,CC=$L(M) Q
W1 S RL=SS+10-T D SU,GETSTR S RL=0 G SM
WRDBACK G LEFT:FCN+IC<2 I FCN+IC<16 S IC=$S(FCN+IC<11:0,1:9) S:FCN>1
FLG=6,FCN=1 G SM
S SS=T F CC=FCN+IC+T-15:-1:T+1 F RC=32,58,44,40,41 I $A(M,CC)=RC S SS=CC,CC=T
Q
G W1
UP I FLN+IR<3 S (MS,ME)=21 G M1
D SCROLUP,GETSTR G SM
EOLN S RL=264
DOWN I FLN+IR>LN S (MS,ME)=22 G M1
D SCROLDN,GETSTR G SM
LEFT S RL=0 I FCN+IC<2 G UP:FLN+IR<3 D SCROLUP,GETSTR G END
I FCN+IC=10 S FLG=$S(FCN>1:6,1:3),FCN=1,IC=T-2 G SM
S IC=IC-1 G SM1:IC+1 S FCN=FCN-9,IC=IC+9 G ALIENS
RIGHT S RL=0 I FCN+IC+1>LS G DOWN:FLN+IR>LN D SCROLDN,PICKUP G HOME
I FCN+IC+1=T S IC=9 G SM1
S IC=IC+1 G SM1:IC<79 S FCN=FCN+9,IC=IC-9 G ALIENS
HOME G UP:FCN+IC<2 S:FCN>9 FLG=6 S (IC,RL)=0,FCN=1 G SM
END G EOLN:FCN+IC+1>LS S:FCN+77<LS FLG=6,FCN=LS-70\9*9+1 S IC=LS-FCN,RL=0 G SM
BOF D SU S:FLN>1 FLG=6 S (IC,FLN,IR)=1 D PICKUP G HOME
EOF D SU S:FLN+19<LN FLG=6 S FLN=$S(LN<21:1,1:LN-19),IR=$S(LN<21:LN,1:20),IC=2
D PICKUP G HOME
PGUP D SU S RL=0 I IR<2&(FCN+IC<2) G UP:FLN<2 S FLN=$S(FLN-20>1:FLN-20,1:1) G
GOTCHA
S:FCN>1 FLG=6 S (FCN,IR)=1,IC=0 D PICKUP G SM
PGDN D SU S RL=0 I IR>19&(FCN+IC<2) G DOWN:FLN+20>LN S
FLN=$S(FLN+39<LN:FLN+20,1:LN-19) G GOTCHA
S:FCN>1 FLG=6 S FCN=1,IC=0,IR=$S(LN<21:LN,1:20) D PICKUP G SM
DELLIN G BRFLBL:LN<2 S ^("DL")=M,UF=0,LN=LN-1 D S RL=FCN+IC D
SCROLUP:FLN+IR-1>LN,CORLIN:LN-FLN<20,GETSTR S RL=0 G ALIENS
.F RC=FLN+IR:1:LN+2 S ^(RC-1)=^(RC)
UNDELLIN D SU D S LN=LN+1,^(FLN+IR-1)=$G(^("DL")," ") S RL=FCN+IC D GETSTR S
RL=0 G ALIENS
.F RC=LN+2:-1:FLN+IR S ^(RC)=^(RC-1)
INSLIN G NOMEM:$S<520 S LN=LN+1 F RC=LN:-1:FLN+IR S ^(RC+1)=^(RC)
S:FCN+IC<10 FCN=1,IC=9 S ^(RC)=$S(FCN+IC+T<$F(M," ",FCN+IC+T-10):" ",'$F(M,"
",FCN+IC+T-10):"
",1:"")_$E(M,FCN+IC+T-10,LS),M=$E(M,1,FCN+IC+T-$S($A(M,FCN+IC+T-11)'=32:11,FCN+
IC=10:11,1:12)),FLG=6,IC=$S(FCN+IC+1>LS:0,1:9),(UF,FCN)=1 D SCROLDN G GOTCHA
INSCHR G OVRCHR:FCN+IC<LS&IM,NOMEM:$S<520,LONGSTR:$L(M)>254 S UF=1,RL=0 I
FCN+IC<10 G RIGHT:$A(M,IC+1)=32&(CK=32) G LONGLBL:T>9&(CK-32) S
M=$E(M,1,IC)_$C(CK)_$E(M,IC+1,LS),T=T+1,IC=IC+1 W:CK-32 $E(M,IC,T-1) D:CK=32 G
SM1
.W $ZL(10-IC," "),$E(M,IC+1,IC+70) S T=$F(M," "),LS=$L(M)+11-T,IC=9
E S LS=LS+1,M=$E(M,1,FCN+IC+T-11)_$C(CK)_$E(M,FCN+IC+T-10,LS) W
$E(M,FCN+IC+T-10,FCN+68+T) G RIGHT
OVRCHR G RIGHT:FCN+IC+1=T S:FCN+IC>9
M=$E(M,1,FCN+IC-11+T)_$C(CK)_$E(M,FCN+IC-9+T,LS) S:FCN+IC<10
M=$E(M,1,IC)_$C(CK)_$E(M,IC+2,LS) S UF=1 W $C(CK) G RIGHT
DELCHR S RL=0 I FCN+IC+1>LS G DOWN:FLN+IR>LN,LONGSTR:$L(M)+$L(^(FLN+IR))>255 S
M=M_^(FLN+IR),LN=LN-1,UF=1 D CORLIN:LN-FLN<20,SU F RC=FLN+IR:1:LN+1 S
^(RC)=^(RC+1)
E G BRFLBL:FCN+IC<10&(IC+3>T) S UF=1 S:FCN+IC>9
M=$E(M,1,IC+T-11+FCN)_$E(M,IC+FCN+T-9,LS),LS=LS-1 W:FCN+IC>9
$E(M,T+$S(FCN+IC<10:0,1:FCN+IC-10),FCN+68+T),*27,"K" D:FCN+IC<10 G SM1
.S M=$E(M,1,IC)_$E(M,IC+2,LS),T=T-1 W $E(M,IC+1,T-1),$ZL(10-T," ")
G GOTCHA
RUBOUT S RL=0 I FCN+IC<2 G UP:FLN+IR<3,LONGSTR:$L(M)+$L(^(FLN+IR-2))>255 S
M=^(FLN+IR-2)_M,UF=1 D SCROLUP,PICKUP,CORLIN:LN-FLN<20 S
FCN=$S(LS<79:1,1:LS-70\9*9+1),IC=LS-FCN,FLG=$S(FCN-1:6,1:3),LN=LN-1 F
RC=FLN+IR:1:LN+2 S ^(RC-1)=^(RC)
E G LEFT:FCN+IC=10 S UF=1 S:FCN+IC>9
M=$E(M,1,IC-12+FCN+T)_$E(M,IC+FCN+T-10,LS),LS=LS-1 ZM $S(FCN+IC>9:IC-1,1:0),IR
D:FCN+IC<10 W:FCN+IC>9 $E(M,T+$S(FCN+IC<10:0,1:FCN+IC-11),FCN+68+T),*27,"K" G
LEFT
.S M=$E(M,1,IC-1)_$E(M,IC+1,LS),T=T-1 W $E(M,1,T-1),$ZL(10-T," ")
G GOTCHA
LONGLBL S MS=3,ME=5 G M1
LONGSTR S MS=6,ME=8 G M1
NOMEM S MS=15,ME=16 G M1
BRFLBL S MS=8,ME=14 G M1
NOBLK S MS=23,ME=25 G M1
NOBUF S MS=26,ME=27 G M1
M1 D TYPMSG G SM
WRP G GETC ; S W='W G ALIENS
BUFIN S SS=FLN+IR-BR D SU I SS>0 D S BP=BP+SS Q
.F RC=0:1:SS-1 S ^("B"_(BP+RC))=^(RC+BR)
S SS=1-SS D S BP=BP+SS+1 Q
.F RC=0:1:SS S ^("B"_(BP+RC))=^(BR-SS+RC)
KILBLK S SS=FLN+IR-BR I SS>0 D S
LN=LN-SS,IR=IR-$S(LN<21:SS,FLN-SS<1:SS-FLN,1:0),FLN=$S(LN<21:1,FLN-SS<1:1,1:FLN
-SS)
.F RC=BR:1:FLN+IR-1 S ^(RC)=^(RC+SS)
E S SS=2-SS D S
LN=LN-SS,IR=IR-$S(LN<21:SS,FLN-SS+20>LN:FLN-SS-LN+19,1:0),FLN=$S(LN<21:1,FLN-SS
+20>LN:LN-19,1:FLN-SS)
.F RC=FLN+IR-1:1:BR S ^(RC)=^(RC+SS)
S RL=FCN+IC G GETSTR
COPY S:BR BP=0
APPEND G NOBLK:'BR D BUFIN G SM1
CUT S:BR&$S(FLN+IR>BR&(FLN+IR-BR+2>LN):0,1:BR-FLN-IR+2<LN) BP=0
MOVE G NOBLK:'BR,BRFLBL:$S(FLN+IR>BR&(FLN+IR-BR+2>LN):1,1:BR-FLN-IR+3>LN)
D BUFIN,KILBLK S RL=0,FLG=6 G MARKOFF
PASTE G NOBUF:'BP D SU F RC=LN+1:-1:FLN+IR-1 S ^(RC+BP)=^(RC)
F RC=0:1:BP-1 S ^(FLN+IR+RC-1)=^("B"_RC)
S LN=LN+BP,IR=IR+$S(LN<21:BP,FLN+BP+20>LN:FLN+BP-LN+19,1:0),FLN=$S(LN<21:1,FLN
+BP
+20>LN:LN-19,1:FLN+BP) S RL=FCN+IC D GETSTR S RL=0 G ALIENS
MARKBLK S BR=FLN+IR-1,BC=$S(FCN+IC>9:FCN+IC-9+T,1:IC+1) ZM 60,0 W
"БЛОК=",BR,":",BC,?75 G SM1
MARKOFF S BR=0 ZM 60,0 W $ZL(14," ") G SM
CLEAR S BP=0 G SM1
QUIT D SU
S ^FMU($I)="S LN=^FMU($I,0) ZR F RC=1:1:LN ZI ^(RC) I RC+1>LN ZS "_FT_"
ZR",^($I,0)=LN J ENTRY^%FMUEXEC
F RC=0:1:300 H 1 Q:^FMU($I)
I RC>299 ZM 0,21 W "НЕТ ОТВЕТА !",*7 H 2
ABORT ZM 0,0 W *27,*74,*27,">" U 0:(80::::128:1) K
PR,PC,IM,M,MN,T,TN,FLN,FCN,SC,UF,LS,RL,MS,ME,R,RN,SS,GF,BR,BC,BP,^FMU($I) S
^($I)=FT K FT Q
SEEK U 0:(::::128:1) ZM 0,21 R "ОБРАЗЕЦ ДЛЯ ПОИСКА: ",SN#60 U 0:(::::129) D
CRUNCH S RC=0 S:SN=""&(S="") RC=LN+1 Q:RC>LN S:SN'="" S=SN S
SR=FLN+IR-1,SC=IC+$S(FCN+IC<10:1,1:FCN-10+T) I $F(^(SR),S,SC) S
SC=$F(^(SR),S,SC)
E F RC=SR+1:1:LN+1 S SS=$F(^(RC),S) Q:SS
E S:RC'>LN SR=RC,SC=SS
I RC>LN S MS=18,ME=20 S:SN="" MS=17 G TYPMSG
D SU S:SR-FLN>19 FLG=6 S
FLN=$S(SR-FLN<20:FLN,LN<21:1,SR+10>LN:LN-19,SR-10<1:1,1:SR-10),SR=SR+1,RL=0,IR=
SR-FLN G PICKUP
REPLACE U 0:(::::128:1) ZM 0,21 R "ЗАМЕНЯЮЩИЙ ОБРАЗЕЦ: ",RN#60 D CRUNCH
S:RN'="" R=RN I RN="" R "ИСПОЛЬЗОВАТЬ СТАРЫЙ ОБРАЗЕЦ?(Y/Д) ",RN#1 D CRUNCH S
R=$S(RN="Y"!(RN="Ы"):R,RN="D"!(RN="Д"):R,1:"")
D SEEK G SM1:RC>LN G R1:$L(M)-$L(S)+$L(R)>254 S
M=$E(M,1,SC-$L(S)-1)_R_$E(M,SC,LS),UF=1,SS=T,SC=SC+$L(R)-$L(S) D SU,PICKUP I
SC-$L(R)<SS S:FCN>1 FLG=6,FCN=1 D W:FLG<6 $E(M,1,T-1),$ZL(10-T,"
"),$E(M,T,$S(LS>80:69+T,1:LS))
.S IC=SC-$S(SC<T:1,1:T-10),UF=1 S:$F(R," ")-$F(S,"
")+SS>10!($L(R)-$L(S)+SS>10!(S[" "&'(R[" "))) M=$E(M,1,SC-$L(R)-1)_"
"_$E(M,SC-$L(R),$L(M)),SC=SC+1,LS=LS+1,IC=9 ZM 0,IR D SU,PICKUP
E S RL=SC+10-T ZM 0,IR D GETSTR,TYPSTR:FLG<6
S RL=0 G SM
R1 S RL=SC+10-T D GETSTR G LONGSTR
SEARCH D SEEK G SM1:RC>LN I SC-$L(S)<T S:FCN>1 FLG=6,FCN=1 S
IC=SC-$S(SC<T:1,1:T-9),RL=0
E S RL=SC+10-T ZM 0,21 D GETSTR S RL=0
SM G ALIENS:FLG-3
SM1 ZM 35,0 W $J(FLN+IR-1,5) ZM 49,0 W $J(FCN+IC,3) ZM IC,IR G GETC
TYPSTR W:FCN<9 $E(M,1,T-1),$ZL(10-T," "),$E(M,T,$S(LS>79:69+T,1:LS)) W:FCN>1
$E(M,FCN+T-10,FCN+68+T) Q
TYPMSG ZM 0,21 W $P($T(TYPMSG+(MS\256+1))," ",MS#256,ME),*7 G CRUNCH1
; СЛИШКОМ ДЛИННАЯ МЕТКА СЛИШКОМ ДЛИННАЯ СТРОКА ДОЛЖНА НАЧИНАТЬСЯ С МЕТКИ ИЛИ
ПРОБЕЛА МАЛО ПАМЯТИ ПОВТОРНО ОБРАЗЕЦ НЕ НАЙДЕН [BOF] [EOF] БЛОК НЕ ОТМЕЧЕН БУФЕР
ПУСТ .
GOTCHA D PICKUP G ALIENS
PICKUP S M=^(FLN+IR-1),T=$F(M," "),LS=$L(M)+11-T Q
GETSTR D PICKUP S:FCN+IC<10&'RL RL=FCN+IC I FCN+IC<LS D:RL Q
.I RL'>LS S:RL-FCN>77 FLG=6,FCN=RL-61\9*9+1 S
IC=$S(RL<T:RL-1,RL<10:T-2,1:RL-FCN) D G1:RL<FCN
.E S:LS-FCN>77 FLG=6,FCN=LS-70\9*9+1 S IC=LS-FCN
I '(RL<LS&RL) Q:FCN+IC=+LS S:'RL RL=FCN+IC S:FCN>LS
FCN=$S(LS<79:1,1:LS-70\9*9+1),FLG=6 S IC=LS-FCN Q
G1 S:FCN>RL FLG=6,FCN=$S(RL>78:RL-70\9*9+1,1:1) S IC=RL-FCN Q
SCROLUP D SU S IR=IR-1 S:IR<1 IR=1,FLN=FLN-1,FLG=6 Q
SCROLDN D SU S IR=IR+1 S:IR>20 IR=20,FLN=FLN+1,FLG=6 Q
CORLIN S:LN>20 IR=IR+1,FLN=FLN-1 Q
CRUNCH ZM 0,21 W *27,"K" Q
CRUNCH1 H 2 G CRUNCH
SU Q:'UF S UF=0,^(FLN+IR-1)=M Q
HELP D EDITOR^%QEHELP G RFRSH
NOPG W "НЕТ ТАКОЙ !",!,*7 G PGNM
K S K=0 G ENTRY
Q I $ZE["<INRPT>" W ! K Q
ERHND U 0:(80::::128:1) W *27,"H",*27,"J",*27,">" I $ZE["<INRPT>" K
PR,PC,IM,M,MN,T,TN,FLN,FCN,SC,UF,LS,RL,MS,ME,R,RN,SS,GF,BR,BC,BP,^FMU($I) S
^($I)=FT K FT G ENTRY
ZM 0,23 W *27,*75,$ZE,!
W R CK ZQ
Примечание: под традиционным следует понимать - почти без комментариев,
стараться выжать максимальную длину строки, GOTO без разбора, сокращённые
формы команд. ZM 0,21 в данной программе означает позиционирование в
0 колонку 21 строки на экране. Ну-ка, пусть кто-нибудь попробует понять,
что там делается-в кишках программы.;-)
------------------------------------------------------------------------
Приложение 4: Темы, требующие освещения.
1) MUMPS & Internet/Intranet.
2) MUMPS & объектно-ориентированное программирование, в частности SSVN.
3) MUMPS & внешний мир, в частности API и ZCALLы.
4) GUM.
------------------------------------------------------------------------
Приложение 5: Благодарности. Лица, принимавшие участие в составлении.
Составитель, точнее компилятор %) Бохонкович Ю.Г. aka 2:5000/83.20
aka mumpster@cip.nsk.su.
При составлении в основном использовались материалы comp.lang.mumps FAQ
и свои данные. Предлагаю всем заинтересованным лицам принять участие в
обсуждении.
Special Thanx to Gardner Trask.:D
{с его особого разрешения}
в обсуждении принимали участие:
Anton Parfyonov 2:5020/218
Serg W Michailenko 2:5020/438.33
Sergei Obrastsov 2:5047/8
Serg Gavrilov 2:5061/15.36
Konstantin Malyavin 2:5000/88.5
------------------------------------------------------------------------
Секция 2 из 2 - Предыдущая - Следующая
© faqs.org.ru
