faqs.org.ru

 Главная > Программирование > Работа с базами данных >

FAQ по М-технологии и языку программирования MUMPS

Секция 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