::   ::   ::   ::   ::
 
 

Foros de discusión HispaSeti
Unión de los grupos Hispanos de [email protected]
 
 RegistrarseRegistrarse 
 FAQFAQ   BuscarBuscar   MiembrosMiembros   Grupos de UsuariosGrupos de Usuarios   RegistrarseRegistrarse   Volver a la Web principalVolver a HispaSeti.org
 PerfilPerfil   Entre para ver sus mensajes privadosEntre para ver sus mensajes privados   LoginLogin 

Business Basic
Ir a página 1, 2  Siguiente
 
Publicar nuevo tema   Responder al tema    Foros de discusión -> Informática y Ordenadores
Ver tema anterior :: Ver tema siguiente  
Autor Mensaje
invitado-2
Invitado





MensajePublicado: Lun 22 May 2006 22:26:03    Asunto: Business Basic Responder citando

Esto es Business Basic.

La instrucción tipo PROCESS "nombre_panel","librería",X$, y más variables
es como se llama a Nomads desde un programa de basic.

Este programa es el programa que edita los programas/librerías
tipo Nomads (el programa usa el propio Nomads para editarse).
Los Paneles/Forms, Querys y Objetos que usa Nomads están en el fichero scrnlib.en
(este fichero ocupa unos 600 Kb.)(fichero multiclave)
Desde este programa se pueden editar la propia librería de Nomads.

La instrucción PERFORM es como un CALL con todas las variables compartidas.


0010 ! *NOMADS - GUI Application Developer
0020 ! (c) Copyright 2001 Best Software Canada Ltd.
0030 LET SV_TC=PRM('TC'); SET_PARAM 'TC'=6+8
0035 LOCAL SV_CAPTION$; MULTI_LINE READ 0,SV_CAPTION$,ERR=*NEXT
0040 PRINT 'CAPTION'("ProvideX"+$AE$+" NOMADS"),'CS',
0050 PRINT '_WHITE','BLACK','CS','C0',

las siguientes no están operativas ... era una foto de propaganda

0060 ! CALL "*picture;get_size",ERR=0120,"*win/nomads2.bmp",_OBJ_W,_OBJ_H
0070 ! LET _OBJ_W=INT(_OBJ_W),_OBJ_H=INT(_OBJ_H)
0080 ! PERFORM "*winproc;center_wdw"
0090 ! PRINT 'DIALOGUE'(_OBJ_C,_OBJ_L,_OBJ_W,_OBJ_H,"",'MODE'($000F$)+'CS',OPT=
0090:"h^"),'SR','PICTURE'(0,0,@X(_OBJ_W),@Y(_OBJ_H),"*win/nomads2"),'SWAP',
0100 ! LET PICTURE_UP=1
0110 ! GOTO 0220

0120 PRINT 'SB','BLUE','FONT'("Arial",3,"BIUR"),'TEXT'(@X(40),@Y(MXL(0)-5),@X(M
0120:XC(0)),@Y(MXL(0)-2),"NOMADS"),'BLACK','SF','FONT'("Arial",1.5,"BIR"),'TEXT
0120:'(@X(40),@Y(MXL(0)-2),@X(MXC(0)),@Y(MXL(0)),"by Best Software Canada Ltd."
0120:),
0130 WAIT .2

mira si está en windows

0140 IF DLM="/" OR POS("WIN"=SYS)=0 THEN GOTO 0210

0150 PRINT '-T',
0160 FOR I=60 TO 85 STEP .6
0170 PRINT 'IMAGE'("Twinkie"),'PEN'(1,3,7),'LINE'(@X(I),@Y(1Cool,@X(I-3),@Y(24)),
0180 WAIT 0
0190 PRINT 'IMAGE'(DELETE "Twinkie"),
0200 NEXT
0210 WAIT 0; PRINT '+T',

carga variables globales de nomads

0220 LET %NOMAD_DEF_SFX$="EN",%NOMAD_DEF_GRID$="2",%NOMAD_DEF_3D$="1",%NOMAD_DE
0220:F_PATH$="S",%NOMAD_DEF_PATHCASE$="A"
0230 LET X=HFN; OPEN (X,ERR=1000)"providex.nmd"
0240 READ (X,ERR=0250)IOL=8020
0250 CLOSE (X)

punto de control del programa

1000 ! 1000 - Await function

carga *ini histórico de accesos a otras librerías

1010 GOSUB 6000

1020 OBTAIN (0,SIZ=1)'C0','ME',X$,'MN'

no está operativo (lo de la propaganda en pantalla lo quita)

1030 ! IF PICTURE_UP THEN PRINT 'SWAP','POP',; LET PICTURE_UP=0

1040 IF CTL=1001 THEN GOSUB OPEN_LIBRARY; GOTO 1000
1050 IF CTL=1008 THEN GOSUB NEW_LIBRARY; GOTO 1000
1060 IF CTL=1009 THEN GOSUB BULK_EDIT; GOTO 1000
1070 IF CTL=1010 THEN GOSUB LIB_COMP; GOTO 1000
1075 IF CTL=1012 THEN GOSUB LIB_MERGE; GOTO 1000
1080 IF CTL=1003 THEN GOSUB CHG_DIR; GOTO 1000
1090 IF CTL=1 THEN GOSUB GET_HELP; GOTO 1000
1100 IF CTL=2001 THEN GOSUB GET_TUTOR; GOTO 1000
1110 IF CTL=2002 THEN GOSUB GET_SECURITY; GOTO 1000
1120 IF CTL=4 OR CTL=-1999 THEN GOTO WRAPUP

gestión de mensajes

1125 IF CTL=1011 THEN MENU_BAR RESET ; PROCESS "msgmngr","*win/scrnlib.en"; GOT
1125:O 1000

gestión grupos de objetos

1127 IF CTL=1013 THEN MENU_BAR RESET ; PROCESS "groupmtc","*win/scrnlib.en"; GO
1127:TO 1000

diccionario de campos y mantenimientos de ficheros

1130 IF CTL=1002 THEN MENU_BAR RESET ; CALL "*dict/maint"; GOTO 1000
1140 IF CTL=1004 THEN MENU_BAR RESET ; PROCESS "secmaint","*win/scrnlib.en"; GO
1140:TO 1000

mantenimiento usuarios

1150 IF CTL=1005 THEN MENU_BAR RESET ; PROCESS "usrmaint","*win/scrnlib.en"; GO
1150:TO 1000

valores del sistema

1160 IF CTL=1006 THEN PROCESS "sys_defaults","*win/scrnlib.en"; GOTO 1000

clases de objetos

1170 IF CTL=1007 THEN PROCESS "Class_def","*win/scrnlib.en"; GOTO 1000

utilidades del sistema

1175 IF CTL=1014 THEN PROCESS "gu_main","*gui/guiutils.en"; GOTO 1000

1180 IF CTL>3000 AND CTL<3011 THEN GOSUB MENU_SELECT; GOTO 1000
1185 IF CTL=9000 THEN GOSUB ABOUT_IT; GOTO 1000
1190 GOTO 1020

2000 ! 2000 - Open a library
2010 OPEN_LIBRARY:
2020 GOSUB FIND_LIBRARY
2030 IF LIB_FN=0 THEN RETURN
2040 GOTO LOAD_LIB

2100 ! ^100 - Open/create library
2110 NEW_LIBRARY:
2120 GET_FILE_BOX LB_PTH$,LWD,"Development Library","Nomads lib (*."+%NOMAD_DEF
2120:_SFX$+")|*."+%NOMAD_DEF_SFX$+"/All Files (*.*)|*.*/",%NOMAD_DEF_SFX$
2130 IF LB_PTH$="" THEN RETURN
2160 KEYED LB_PTH$,16,,-2048,ERR=2440
2165 IF LIB_FN<>0 THEN CLOSE (LIB_FN); LET LIB_FN=0
2170 LET X=HFN; OPEN (X)LB_PTH$
2180 LET OBJ_HOTKEY$=%NOMAD_DEF_3D$
2190 WRITE (X,KEY="")IOL=8010
2205 LET LIB_FN=X
2210 GOTO LOAD_LIB

2300 ! ^100 - Load library
2310 LOAD_LIB:
2311 LET %NOMAD_SV_DIR$=LWD,%NOMAD_SV_PFX$=PFX,%NOMAD_SV_MSG$=MSG(*)
2320 LET P$=PTH(LIB_FN)+";"
2321 LET O=POS(";"+LCS(P$)=";"+LCS(LASTLIBS$)); IF O=1 THEN GOTO 2340 ELSE IF O
2321:<>0 THEN LET LASTLIBS$=LASTLIBS$(1,O-1)+LASTLIBS$(O+LEN(P$))
2322 LET LASTLIBS$=P$+LASTLIBS$
2324 LET O=POS(";"=LASTLIBS$,1,9); IF O<>0 THEN LET LASTLIBS$=LASTLIBS$(1,O)
2330 CALL "*inifile;write",ERR=*NEXT,"nomads.ini","History","Names",LASTLIBS$
2340 LET SCR_TYPE$=""
2350 MENU_BAR RESET
2360 MENU_BAR 4,"-[&Quit=4]"; MENU_BAR DISABLE "Q"
2361 LET %NOMAD_DEF_FONT$="",%NOMAD_LIBDEF_FNT$=""; READ (LIB_FN,KEY=DIM(12)+"0
2361:000",DOM=2365)IOL=8010; LET %NOMAD_DEF_FONT$=OBJ_FONT$,%NOMAD_LIBDEF_FNT$=
2361:OBJ_FONT$
2362 IF OBJ_NME$<>"" THEN PREFIX OBJ_NME$
2363 IF OBJ_DEF$<>"" THEN CWDIR OBJ_DEF$,ERR=*NEXT
2364 IF OBJ_MSG$<>"" THEN MESSAGE_LIB OBJ_MSG$,ERR=*NEXT
2365 !
2366 LET __X$="OBJSELECT"; IF %NOMAD_LAST_VIEW$<>"" THEN LET __X$=%NOMAD_LAST_V
2366:IEW$

llama a Nomads de forma local

2370 CALL "*winproc",__X$,"*WIN/SCRNLIB.EN",STR(LIB_FN),SCR_ID$,SCR_TYPE$
2372 IF %NOMAD_NEXT_DESIGN_PANEL$="" THEN GOTO 2380

graba fichero nomads.ini

2374 CALL "*inifile;write",ERR=*NEXT,"nomads.ini","Views","Last",%NOMAD_NEXT_DE
2374:SIGN_PANEL$
2376 LET __X$=%NOMAD_NEXT_DESIGN_PANEL$,%NOMAD_NEXT_DESIGN_PANEL$="",%NOMAD_LAS
2376:T_VIEW$=__X$; GOTO 2370
2380 IF SCR_TYPE$="" THEN GOTO 2420
2385 IF SCR_TYPE$="P" THEN GOSUB POPUP_MENU; GOTO LOAD_LIB

creación/edición query

2390 IF UCS(SCR_TYPE$)="Q" THEN CALL "*win/qrydef",SCR_ID$,LIB_FN; GOTO LOAD_LI
2390:B



2400 IF SCR_TYPE$="F" THEN PROCESS "genmaint","*win/scrnlib.en",SCR_ID$,STR(LIB
2400:_FN); GOTO LOAD_LIB

define librería

2410 CALL "*win/define",SCR_ID$,LIB_FN; GOTO LOAD_LIB
2420 PRINT 'MESSAGE'(""),; GOSUB 6000
2421 CWDIR %NOMAD_SV_DIR$; PREFIX %NOMAD_SV_PFX$; MESSAGE_LIB %NOMAD_SV_MSG$
2430 RETURN
2440 MSGBOX MSG(RET)+SEP+"Unable to create library"
2450 RETURN

edición librería

2500 ! ^100 - Bulk edit
2510 BULK_EDIT:
2520 GOSUB FIND_LIBRARY
2530 IF LIB_FN=0 THEN RETURN
2540 LET X$=PTH(LIB_FN); CLOSE (LIB_FN)
2550 PROCESS "libedit","*win/scrnlib.en",X$
2560 RETURN



2600 ! ^100 - Select directly from menu
2610 MENU_SELECT:
2620 LET N=CTL-3000
2630 LET LB_PTH$=MENU_PATHS$[N]
2640 GOSUB CHK_LIBRARY
2650 IF LIB_FN=0 THEN RETURN
2660 GOTO LOAD_LIB

compara librerías

2700 ! 2700 - Compare libraries
2710 LIB_COMP:
2720 GOSUB FIND_LIBRARY
2730 IF LIB_FN=0 THEN RETURN
2740 LET X$=PTH(LIB_FN); CLOSE (LIB_FN)
2750 PROCESS "libcomp","*win/scrnlib.en",X$
2760 RETURN

mezcla librerías

2800 ! 2800 - Merge libraries
2810 LIB_MERGE:
2820 GOSUB FIND_LIBRARY
2830 IF LIB_FN=0 THEN RETURN
2840 LET X$=PTH(LIB_FN); CLOSE (LIB_FN)
2850 PROCESS "libmerge","*win/scrnlib.en",X$
2860 RETURN

buscar librería nomad (son ficheros multiclave con los tipos de objetos y propiedades)

2900 ! 2900 - Open library
2910 FIND_LIBRARY:
2920 IF LIB_FN<>0 THEN CLOSE (LIB_FN); LET LIB_FN=0
2930 GET_FILE_BOX READ LB_PTH$,LWD,"Development Library","Nomads lib (*."+%NOMA
2930:D_DEF_SFX$+")|*."+%NOMAD_DEF_SFX$+"/All Files (*.*)|*.*/"

2940 CHK_LIBRARY:
2950 IF LB_PTH$="" THEN RETURN
2955 IF LIB_FN<>0 THEN CLOSE (LIB_FN); LET LIB_FN=0
2960 LET X=HFN; OPEN (X,NBF=10,ERR=*RETURN)LB_PTH$
2970 LET X$=FIB(X); IF DEC(X$(11,1))<>16 OR X$(19,1)<>"K" THEN GOTO 2990
2980 LET LIB_FN=X,LB_PTH$=PTH(X); RETURN
2990 CLOSE (X); MSGBOX "Invalid library format"; RETURN

cambiar de directorio

3000 ! 3000 - Change directory
3010 CHG_DIR:
3020 LET D$=""; CALL "*getdir",D$,"New current Directory"
3030 IF D$<>"" THEN CWDIR D$
3040 RETURN

asigna grupos de objetos en un panel

3500 ! 3500 - Assign Groups to Panel
3510 ASSIGN_GROUPS:
3520 PROCESS "GROUPMTC","*win/scrnlib.en"
3530 RETURN



6000 ! 6000 - Display Menu_bar
6010 MENU_BAR:
6020 MENU_BAR RESET
6030 LET MENU$="",LASTLIBS$="",%LAST_LIBS$=""
6032 IF %NOMAD_LAST_VIEW$<>"" THEN GOTO 6040

6034 CALL "*inifile;read",ERR=*NEXT,"nomads.ini","Views","Last","",__X$; LET %N
6034:OMAD_LAST_VIEW$=__X$

6040 CALL "*inifile;read",ERR=6170,"nomads.ini","History","Names","",LASTLIBS$,
6040:2000
6050 IF LASTLIBS$="" THEN GOTO 6170 ELSE LET X$=LASTLIBS$,MENU$=",",M=0; DIM ME
6050:NU_PATHS$[10]
6060 LET O=POS(";"=X$); IF O=0 THEN GOTO 6165 ELSE LET P$=X$(1,O-1),X$=X$(O+1)
6070 LET M=M+1,MENU_PATHS$[M]=P$
6080 LET X2$=LWD+DLM; FOR O=1 TO LEN(X2$)
6090 IF LCS(X2$(O,1))<>LCS(P$(O,1)) THEN EXITTO 6110
6100 NEXT
6110 IF O<2 THEN GOTO 6140
6120 LET O=POS(DLM=P$(1,O-1),-1)
6121 IF DLM="\" AND O=3 AND P$(2,1)=":" THEN GOTO 6140
6125 LET P$=P$(O+1),X2$=X2$(O+1)
6130 LET O=POS(DLM=X2$,1,0),P$=DIM(O*3,".."+DLM)+P$
6140 IF LEN(P$)>30 THEN LET P$=P$(1,15)+"..."+MID(P$,-10)
6150 LET MENU$=MENU$+",&"+STR(M)+":"+P$+"="+STR(3000+M),%LAST_LIBS$=%LAST_LIBS$
6150:+P$+","
6160 GOTO 6060

opciones menú

6170 MENU_BAR 1000,"-[&Library,&Dictionary,&Security,&Options,&Help,&Utilities=
6170:1014,&Quit=4],L:[&New=1008,&Open=1001,&Bulk edit=1009,&Compare=1010,&Merge
6170:=1012"+MENU$+"],O:[&System Defaults=1006,&Message Manager=1011,&Group Assi
6170:gnment=1013,&Change Directory=1003],D:[&Maintenance=1002,&Classes=1007],S:
6170:[&Classifications=1004,&Users=1005],H:[&Contents=1,&Security=2002,,&About=
6170:9000]"
6180 RETURN

ayudas

7000 ! 7000 - Get help
7010 GET_HELP: LET T$="Introduction"; GOTO DO_HELP
7020 GET_TUTOR: LET T$="Tutorial"; GOTO DO_HELP
7030 GET_SECURITY: LET T$="Security System"; GOTO DO_HELP
7040 DO_HELP:
7050 SYSTEM_HELP "*win/../../help/NOMADS.HLP",T$
7060 RETURN
7070 MSGBOX "Sorry -- No help found","Aw Shucks","!"; RETURN
7500 ! 7500 - About information
7510 ABOUT_IT:
7520 MSGBOX "ProvideX "+$AE$+" - NOMADS"+SEP+SEP+"Graphical Application Develop
7520:er"+SEP+"Version 5.01"+SEP+$A9$+" Copyright 1995-2001 Best Software Canada
7520: Ltd.","About NOMADS","info"
7530 RETURN
7700 ! ^100 - Popup menu logic
7710 POPUP_MENU:
7750 PROCESS "MENUBAR","*win/scrnlib.en",STR(LIB_FN),UCS(SCR_ID$),"P"
7760 RETURN

campos de las librerias de nomads

8000 ! 8000 - IOLISTS
8010 IOLIST OBJ_NME$,OBJ_C,OBJ_L,OBJ_W,OBJ_H,OBJ_TYPE$,OBJ_TXT$,OBJ_VAL$,OBJ_TA
8010:B,OBJ_DEF$,OBJ_DSP$,OBJ_FCS$,OBJ_SEL$,OBJ_MSG$,OBJ_HLP$,OBJ_ATTR$,OBJ_IDX$
8010:,OBJ_HOTKEY$,OBJ_QRY$,OBJ_SEC$,OBJ_STS$,OBJ_GRP$,OBJ_NULL$,OBJ_TAG$,OBJ_TB
8010:L$,OBJ_INP$,OBJ_OUT$,OBJ_VALID$,OBJ_CLASS$,OBJ_TIP$,OBJ_ORIG$,OBJ_FONT$,OB
8010:J_COLOR$,OBJ_LISTBOX_TYPE$,OBJ_SEP$,OBJ_SCRATCH$,OBJ_POPUP$,OBJ_SIZING$,OB
8010:J_LOGIC1$,OBJ_LOGIC2$,OBJ_POPUP_LOGIC$
8020 IOLIST %NOMAD_DEF_SFX$,%NOMAD_DEF_COL$,%NOMAD_DEF_LINE$,%NOMAD_DEF_WIDTH$,
8020:%NOMAD_DEF_HEIGHT$,%NOMAD_DEF_VAL$,%NOMAD_DEF_3D$,%NOMAD_DEF_GRID$,%NOMAD_
8020:DEF_PATH$,%NOMAD_DEF_PATHCASE$

final

9000 ! 9000 - Wrapup
9010 WRAPUP:
9020 PRINT 'RM','CS','MESSAGE'(""),
9030 IF LIB_FN<>0 THEN CLOSE (LIB_FN); LET LIB_FN=0
9040 SET_PARAM 'TC'=SV_TC
9045 IF SV_CAPTION$<>"" THEN PRINT 'CAPTION'(SV_CAPTION$)
9050 MENU_BAR RESET
9060 END
Volver arriba
invitado-2
Invitado





MensajePublicado: Mar 23 May 2006 10:53:43    Asunto: Responder citando

Para Oldnu7 ...

El fichero scrnlib.en es tan "grande" porque contiene las características
de todos los controles y forms (cerca de 4000) que utiliza el programa
Nomads para editar los propios programas o módulos realizados
por Nomads en el entorno GUI.
Volver arriba
Oldno7
Administrador del Foro
Administrador del Foro


Registrado: 22 Mar 2002
Mensajes: 1829

MensajePublicado: Mar 23 May 2006 17:33:48    Asunto: Responder citando

bueno... la verdad es que lo veo bastante claro. Gracias por las explicaciones y anotaciones.
Me has avivado las ganas de probarlo... a ver si encuentro un hueco y te comento.
_________________
Ojala vivas en tiempos interesantes.
(antigua maldicion china)
Volver arriba
Ver perfil de usuario Enviar mensaje privado Enviar email Visitar sitio web del autor Yahoo Messenger
invitado-2
Invitado





MensajePublicado: Mar 23 May 2006 19:30:09    Asunto: Responder citando

Si ejecutas el interprete Basic o Providex (no la opción Nomads)
...

para ver el programa de nombre "_nomads" que está en la
carpeta ../lib puedes hacerlo con

load"*nomads"

el * sustituye el _ del nombre

si haces list te sale que el programa está protegido por
password, pero EL PASSWORD es password
(típico de los programas de Providex)

para ver el list hay que hacer

password "password"
Volver arriba
invitado-2
Invitado





MensajePublicado: Mar 23 May 2006 19:34:59    Asunto: Responder citando

manual en linea en

http://manual.pvxplus.com/
Volver arriba
invitado-2
Invitado





MensajePublicado: Mie 24 May 2006 12:04:14    Asunto: Responder citando

Este es el AUTENTICO CORAZON del programa Nomad
(no se si cabrá en el Email)

0010 ! *WINPROC - Windows processor {Prerelease version Nov 95}
0020 ! (c) Copyright 1995-1998, ProvideX Technologies (Ontario, Canada)
0021 LET SV_PRC=PRC; RESET ; PRECISION SV_PRC
0030 ENTER (SCRN_ID$),(SCRN_LIB$),ARG_1$,ARG_2$,ARG_3$,ARG_4$,ARG_5$,ARG_6$,ARG
0030:_7$,ARG_8$,ARG_9$,ARG_10$,ARG_11$,ARG_12$,ARG_13$,ARG_14$,ARG_15$,ARG_16$,
0030:ARG_17$,ARG_18$,ARG_19$,ARG_20$,ERR=POST_ENTER
0040 POST_ENTER:
0041 IF %NOMADS_PROCESS$<>"" THEN CALL %NOMADS_PROCESS$,ERR=*NEXT,SCRN_ID$,SCRN
0041:_LIB$
0042 IF %NOMADS_CTL_RESET$="" THEN LET %NOMADS_CTL_RESET$="BRC3LDVXM|_"
0050 LET _SCR_LIB=-1,_WDW=0,_SCR_MSG$=$00$,_SCR_ATTR$=$00$,_SCR_H_ID$=$00$,_SV_
0050:PFX$=$00$,_SV_DIR$=$00$,_SCR_3D=-1
0051 LET _RSZ_IMG$=""
0055 LET SV_PNL_DEF_FONT$=%NOMAD_PNL_DEF_FONT$,SV_PNL_DEF_COLOUR$=%NOMAD_PNL_DE
0055:F_COLOUR$
0060 LET SCRN_K$=PAD(UCS(SCRN_ID$),12),_SCREEN_K$=SCRN_K$ ! 12 character screen
0060: names
0070 IF PRM('PC')=0 AND %NOMAD_PRG_CACHE>0 THEN SET_PARAM 'PC'=%NOMAD_PRG_CACHE
0080 ERROR_HANDLER READ _SV_ERRH$; IF _SV_ERRH$="" THEN ERROR_HANDLER "*winerr"
0090 LET _SV_WI=PRM('WI'),_SV_TU=PRM('TU'),_SV_EX=PRM('EX')
0100 SET_PARAM -'EX'
0103 IF %NOMAD_TURBO_OFF THEN SET_PARAM -'TU' ELSE SET_PARAM 'TU'
0105 IF NOT(%NOMAD_NOPLUSW) THEN PRINT '+W',
0110 IF SCRN_LIB$<>"" THEN GOTO 0130
0120 IF %SCR_LIB=0 THEN MSGBOX "No screen library defined","Screen Manager","!,
0120:BEEP"; STOP ELSE LET SCRN_LIB$=%SCR_LIB$; GOTO 0300
0130 LET _X=GFN; IF %NOMAD_OPEN_LOAD THEN OPEN LOAD (_X,ERR=8900)SCRN_LIB$ ELSE
0130: OPEN (_X,ERR=8900)SCRN_LIB$
0140 LET _X$=FIB(_X); IF DEC(_X$(11,1))=14 THEN CLOSE (_X); MSGBOX "Library is
0140:old format"+SEP+"Convert to new format?","Automatic Update","?,YESNO",_X$;
0140: IF _X$="YES" THEN CALL "*winproc.cnv",SCRN_LIB$; GOTO 0130 ELSE GOTO 9000
0150 IF DEC(_X$(11,1))<>16 OR _X$(19,1)<>"K" THEN MSGBOX "Not a valid object li
0150:brary","","!"; CLOSE (_X); EXIT
0160 IF UCS(PTH(_X))=UCS(PTH(%SCR_LIB)) THEN CLOSE (_X); GOTO 0300
0170 LET _SCR_LIB=%SCR_LIB,_SCR_ATTR$=%SCR_DEF_ATTR$,_SCR_3D=%SCR_3D,%SCR_LIB=_
0170:X,%SCR_DEF_ATTR$="",%SCR_3D=0
0180 READ (_X,KEY=DIM(12)+"0000",DOM=0300)IOL=8010
0185 LET %NOMAD_PNL_DEF_FONT$=_OBJ_FONT$,%NOMAD_PNL_DEF_COLOUR$=_OBJ_COLOR$
0190 IF STP(_OBJ_MSG$,2)<>"" THEN LET _SCR_MSG$=MSG(*); MESSAGE_LIB _OBJ_MSG$,E
0190:RR=*NEXT
0200 GOSUB ATTR_CHK; LET %SCR_DEF_ATTR$=_OBJ_ATTR$
0205 LET _DEFAULT_EXTERNAL_HELP=1 ! set to external help for default
0210 LET _SCR_H_ID$=%SCR_DEF_H_ID$,_SCR_H_FL$=%SCR_DEF_H_FL$,_X$=_OBJ_HLP$; GOS
0210:UB GET_HELP; LET _DEFAULT_EXTERNAL_HELP=_EXTERNAL_HELP; LET %SCR_DEF_H_ID$
0210:=_H_ID$,%SCR_DEF_H_FL$=_H_FL$
0220 IF _OBJ_DEF$<>"" THEN LET _SV_DIR$=LWD; CWDIR _OBJ_DEF$,ERR=0230
0230 IF _OBJ_NME$<>"" THEN LET _SV_PFX$=PFX; IF _OBJ_NME$(1,1)="+" THEN PREFIX
0230:PFX+_OBJ_NME$(2) ELSE PREFIX _OBJ_NME$
0240 LET %SCR_3D=(_OBJ_HOTKEY$="1")
0300 ! ^100 - Create window
0310 IF %NOMAD_QRY_BTN$="" THEN LET %NOMAD_QRY_BTN$="?"
0313 IF %NOMAD_QRY_WIDE=0 THEN LET %NOMAD_QRY_WIDE=2
0315 IF %NOMAD_QRY_TIP$="" THEN LET %NOMAD_QRY_TIP$="Query"
0320 READ (%SCR_LIB,KEY=SCRN_K$+"0000",DOM=8800)IOL=8010
0321 IF _OBJ_VALID$=WHO THEN GOSUB CHECK_TEST
0322 USE_WORK_VER: LET MAIN_SCRN_K$=SCRN_K$
0323 IF _OBJ_SEC$<>"" THEN CALL "*secure",_OBJ_SEC$; IF _OBJ_SEC$="" THEN GOTO
0323:END_OBJ ! NO ACCESS TO PANEL
0325 IF _OBJ_TYPE$<>"Q" THEN GOTO 0332
0327 IF %NOMAD_PNL_DEF_FONT$="" OR PAD(%NOMAD_PNL_DEF_FONT$,1)="," THEN LET %NO
0327:MAD_PNL_DEF_FONT$=SV_PNL_DEF_FONT$
0328 IF %NOMAD_PNL_DEF_COLOUR$="" THEN LET %NOMAD_PNL_DEF_COLOUR$=SV_PNL_DEF_CO
0328:LOUR$
0330 IF _OBJ_TYPE$="Q" THEN RUN "*winqry"
0332 IF %NOMADS_PRE_DISPLAY$<>"" THEN PERFORM %NOMADS_PRE_DISPLAY$,ERR=*NEXT
0333 IF _OBJ_FONT$<>"" THEN LET %NOMAD_PNL_DEF_FONT$=_OBJ_FONT$
0334 IF _OBJ_COLOR$<>"" THEN LET %NOMAD_PNL_DEF_COLOUR$=_OBJ_COLOR$
0335 PRINT 'IMAGE'("*winproc*"),
0340 IF %DBG_FL THEN PRINT (%DBG_FL)"<Nomads>",_SCREEN_K$,":Start screen. Libr
0340:ary="+PTH(%SCR_LIB)
0341 IF _OBJ_INP$="" THEN LET DEFAULT_PROG$="" ELSE IF _OBJ_INP$(1,1)="=" THEN
0341:LET DEFAULT_PROG$=EVS(_OBJ_INP$(2)) ELSE LET DEFAULT_PROG$=_OBJ_INP$
0342 GOSUB CHECK_DEF_PRG
0343 LET _SCR_PRC=PRC; IF _OBJ_IDX$<>"" THEN LET _SCR_PRC=MIN(MAX(0,INT(NUM(_OB
0343:J_IDX$,ERR=*NEXT))),14); PRECISION _SCR_PRC
0345 LET _REFRESH_FLG=0,_AUTO_CLOSE=0
0346 IF POS("R"=_OBJ_NULL$) THEN LET _REFRESH_FLG=1,REFRESH_FLG=_REFRESH_FLG
0347 IF POS("C"=_OBJ_NULL$) THEN LET _AUTO_CLOSE=1
0348 LET _FILES_BEFORE$=CHN
0350 IF _OBJ_DSP$<>"" THEN LET CMD_STR$=_OBJ_DSP$; GOSUB 7000 ! pre-display log
0350:ic
0355 IF POS("="=INIT_TEXT$)=1 THEN LET INIT_TEXT$=EVS(INIT_TEXT$(2),ERR=*NEXT)
0360 GOSUB ATTR_CHK; LET _OBJ_ATTR$=%SCR_DEF_ATTR$+_OBJ_ATTR$
0370 LET _SCR_H_ID$=%SCR_DEF_H_ID$,_SCR_H_FL$=%SCR_DEF_H_FL$,_X$=_OBJ_HLP$; GOS
0370:UB GET_HELP; LET _DEFAULT_EXTERNAL_HELP=_EXTERNAL_HELP; LET _SCR_H_ID$=_H_
0370:ID$,_SCR_H_FL$=_H_FL$
0380 IF _SCR_H_FL$<>"" THEN LET _OBJ_STS$=_OBJ_STS$+"?"
0381 LET _ORIG_OBJ_W=_OBJ_W,_ORIG_OBJ_H=_OBJ_H,_MAXIMIZE=0
0382 LET _CST_ADJ=0
0383 IF %NOMAD_CENTER_WDW OR POS("+"=_OBJ_STS$)<>0 THEN LET %NOMAD_CENTER_WDW=0
0383:; GOSUB CENTER_WDW ELSE IF (%NOMAD_RELATIVE_WDW AND _OBJ_TYPE$="D") OR POS
0383:("R"=_OBJ_STS$)<>0 THEN GOSUB RELATIVE_WDW
0384 LET _ORIG_OBJ_C=_OBJ_C,_ORIG_OBJ_L=_OBJ_L
0385 IF %NOMAD_PANEL_INFO_PROG$<>"" THEN GOSUB GET_PANEL_INFO; IF _PNL_MOVE OR
0385:_PNL_SIZE OR _SV_MAX THEN LET _OBJ_L=-100
0386 IF POS("m"=_OBJ_STS$) AND POS("*Z":_OBJ_STS$,1) AND _OBJ_TYPE$="D" THEN GO
0386:SUB GET_XYINFO; LET _OBJ_W=MIN(141,INT(%NOMAD_XMAX/%NOMAD_XCHAR+5)),_OBJ_H
0386:=MIN(141,INT(%NOMAD_YMAX/%NOMAD_YCHAR+5)); LET _MAXIMIZE=1,_OBJ_L=-100
0387 LET _PNL_MAX_W=_OBJ_W,_PNL_MAX_H=_OBJ_H,_PNL_MIN_W=_ORIG_OBJ_W,_PNL_MIN_H=
0387:_ORIG_OBJ_H
0388 IF _OBJ_L>=0 THEN LET %Z__C_L$="" ELSE LET %Z__C_L$=STR(_ORIG_OBJ_C:"000")
0388:+STR(_ORIG_OBJ_L:"000")
0390 WAIT 0; IF _OBJ_TYPE$<>"D" THEN PRINT 'WINDOW'(_OBJ_C,_OBJ_L,_OBJ_W,_OBJ_H
0390:,INIT_TEXT$,'SN'+'SF'+_OBJ_ATTR$,OPT=_OBJ_STS$),'SR','CS', ELSE PRINT 'DIA
0390:LOGUE'(_OBJ_C,_OBJ_L,_OBJ_W,_OBJ_H,INIT_TEXT$,'SN'+'SF'+_OBJ_ATTR$,OPT=_OB
0390:J_STS$),'SR','CS',; IF POS("m"=_OBJ_STS$) THEN LET _OBJ_W=_ORIG_OBJ_W,_OBJ
0390:_H=_ORIG_OBJ_H+_CST_ADJ; PRINT 'SIZE'(_OBJ_W,_OBJ_H), END_IF ; LET _LOAD_F
0390:LAG=LEN(%NOMAD_LOAD_TEXT$); IF _LOAD_FLAG<>0 THEN LET _LOAD_FLAG=MIN(20,MA
0390:X(_LOAD_FLAG,LEN(INIT_TEXT$)))+6; PRINT 'SHOW'(-1),'DIALOGUE'(1,1,_LOAD_FL
0390:AG,3,%NOMAD_LOAD_TEXT$,'B9'+'CS',OPT="Z"),'SIZE'(_LOAD_FLAG,2),'SR','CS',;
0390: WAIT 0; PRINT 'FONT'("MS Sans Serif",1),'TEXT'(@X(0),@Y(0),@X(_LOAD_FLAG)
0390:,@Y(2),INIT_TEXT$,"WC"),'SWAP',; WAIT 0
0391 LET _RESIZE=0; IF TCB(32)>4 THEN IF POS("Z"=_OBJ_STS$) AND (POS("Z"=_OBJ_N
0391:ULL$) OR POS("ZC":_OBJ_SIZING$)) THEN IF POS("C"=_OBJ_SIZING$)=0 THEN LET
0391:_RESIZE=1 ELSE LET _RESIZE=2
0393 IF %NOMAD_ENTER_TAB THEN PRINT '+E',
0394 IF %NOMAD_SCRIPT_WDW<>0 THEN PRINT 'GOTO'(%NOMAD_SCRIPT_WDW),'SWAP',
0395 DEFCTL WINDOW ESC=-1999
0400 LET _WDW=1; PRINT _OBJ_ATTR$,'DF','GF','EL',"1",'FL',"1", ! Assure default
0400: attributes....
0410 IF %SCR_3D THEN PRINT '3D', ELSE PRINT '2D',
0420 IF _OBJ_DEF$>"0" THEN LET _SFX$="$" ELSE LET _SFX$=".val$"
0425 IF POS("="=_OBJ_MSG$)=1 THEN LET _OBJ_MSG$=EVS(_OBJ_MSG$(2))
0430 PRINT 'MESSAGE'(MID(_OBJ_MSG$,1,250)),
0440 LET EXIT_CMD$=_OBJ_SEL$ ! Completion command
0450 LET DISP_CMD$=_OBJ_FCS$ ! Post display cmnd
0460 SETERR 0800
0470 LET TAB_TABLE$="",_DEF_K$=""
0475 LET _SV_PNL_W=_ORIG_OBJ_W,_SV_PNL_H=_ORIG_OBJ_H,_ADJ_C=1,_ADJ_W=1,_ADJ_L=1
0475:,_ADJ_H=1,[email protected](10)/10,[email protected](10)/10,_RESIZING_FLDR=0 ! resize init
0480 DIM _CMD_TBL$[200],_TYPE_TBL$[200],_NAME_TBL$[200],_HLP_TBL$[200],_QRY_TBL
0480:$[200],_FCS_TBL$[200],_INP_TBL$[200],_OUT_TBL$[200],_VLD_TBL$[200],_EXT_CM
0480:D$[200],_POPUP_TBL$[200],_POPUP_LOGIC_TBL$[200],_F_TXT$[20],_F_OBJ$[20],_D
0480:YNAPIC_CMD$[10],_DYNAPIC_VAL$[10],_DYNAPIC_VAR$[10]; LET _ID_LST=0,_EXT_CN
0480:T=0,_GRPS$="",_F_CNT=0,_EOM$="",NEXT_ID=-1,_FORCE_FCS=100000,_VAR_LST$="",
0480:_RBT_TBL$="000000000",_F_CLRTBL$="",_DYNAPIC_CNT=0
0481 DIM _QLST_CTL[200],_QLST_QRY$[200],_QLST_FMT$[200],_QLST_IOL$[200],_QLST_R
0481:EC$[200],_QLST_SEL$[200],_QLST_BTN$[200],_QLST_BTN_REC$[200],_QLST_TST$[20
0481:0],_QLST_PRE$[200],_QLST_POST$[200]; LET _QLST_IDX=0,_QLST_MAIN_PNL_IDX=0,
0481:_QLST_BTN$="",_QLST_MAIN_PNL_BTN$=""
0490 DIM _USR_CMD$[200],_USR_CTL[200],_DRAGON_CMD$[200],_DRAGON_CTL[200],_DRAGO
0490:N_FR_CTL$[200],_DRAGON_TO_CTL$[200],_DEPENDS_COND_TBL$[200],_DEPENDS_ACTIO
0490:N$[200],_DEPENDS_EVN_VALUE[200]; LET _USR_CNT=0,_DRAGON_CNT=0,_DEPENDS_CNT
0490:=0
0495 IF _OBJ_POPUP$<>"" THEN LET _POPUP_TBL$[0]=_OBJ_POPUP$
0497 IF _OBJ_POPUP_LOGIC$<>"" THEN GOSUB CHECK_DEF_PRG
0498 LET _POPUP_LOGIC_TBL$[0]=_OBJ_POPUP_LOGIC$
0500 LET _CUR_IMG$="I_"; GOSUB DISP_SCRN
0501 LET _QLST_MAIN_PNL_IDX=_QLST_IDX,_QLST_MAIN_PNL_BTN$=_QLST_BTN$
0505 LET _S_INIT_IOL$=""; IF NOT(NUL(_IOL$)) THEN LET _S_INIT_IOL$=CPL("IOLIST
0505:"+_IOL$(2)),_S_INIT_VAL$=_VAL$
0510 IF DISP_CMD$<>"" THEN LET CMD_STR$=DISP_CMD$; IF CMD_STR$(1,1)<>"N" THEN G
0510:OSUB 7000 ELSE GOTO NON_NOMADS
0520 IF _F_CNT<>0 THEN LET _F_I=1; GOSUB FLDR_ACTIVE
0522 IF %NOMAD_PANEL_INFO_PROG$<>"" THEN GOSUB RESTORE_PANEL ELSE IF _MAXIMIZE
0522:THEN PRINT 'SHOW'(-1),'MOVE'(_ORIG_OBJ_C,_ORIG_OBJ_L),'SHOW'(1),
0523 LET %Z__C_L$=""
0525 IF %NOMAD_TURBO_OFF THEN SET_PARAM 'TU' ! turn back on after all controls
0525:are drawn
0530 SETERR SYS_ERR
0531 IF _ID_LST=0 THEN OBTAIN (0,SIZ=1)'ME',*,'MN'; GOTO 9000
0532 GOSUB DO_DRAGONS
0534 LET _O=POS(" "=TAB_TABLE$); IF _O=0 THEN LET _CUR_ID=10001 ELSE LET _CUR_I
0534:D=NUM(TAB_TABLE$(_O+1,5))
0560 IF NEXT_ID<>-1 THEN GOTO NEXT_ID_CHK
0561 LET CTL_ENABLED=1; SET_FOCUS _CUR_ID,ERR=0562; GOTO NXT_INP
0562 IF ERR=13 THEN LET CTL_ENABLED=0
0563 GOTO FIND_CUR_ID
0600 ! ^100 - Display all objects
0610 DISP_SCRN:
0611 IF _SCR_PRC<2 THEN PRECISION 2
0612 LET MNU_LN$="",_VAL$="",_IOL$="",_QLST_BTN$=_QLST_MAIN_PNL_BTN$
0613 LET [email protected](0),[email protected](0)
0615 READ (%SCR_LIB,KEY=SCRN_K$+"0000",DOM=*NEXT)
0616 LET _PANEL_ATR$=_OBJ_STS$
0620 LET _OBJ_K$=KEY(%SCR_LIB,END=0762); IF _OBJ_K$>SCRN_K$+"zzzz" THEN GOTO 07
0620:62
0630 READ (%SCR_LIB)IOL=8010
0631 IF _OBJ_K$(13,1)="M" THEN IF _OBJ_K$(14,1)<>" " THEN READ (%SCR_LIB,KEY=SC
0631:RN_K$+"Mzzz",DOM=0620); GOTO 0620 ELSE LET MNU_LN$=MNU_LN$+INIT_TEXT$; GOT
0631:O 0620
0640 IF _OBJ_TYPE$<>"S" AND POS("="=INIT_TEXT$)=1 THEN LET INIT_TEXT$=EVS(INIT_
0640:TEXT$(2),ERR=0840)
0650 IF _OBJ_TYPE$="U" THEN LET _USR_CNT=_USR_CNT+1,_USR_CTL[_USR_CNT]=NUM(_OBJ
0650:_NME$); GOSUB CHECK_DEF_PRG; LET _USR_CMD$[_USR_CNT]=_OBJ_SEL$; GOTO 0620
0653 IF _OBJ_K$(13,1)="V" THEN LET INVERT$=""; GOSUB LOAD_DEPENDS_TBL; LET INVE
0653:RT$=_OBJ_IDX$; IF INVERT$="Y" THEN GOSUB LOAD_DEPENDS_TBL; GOTO 0620 ELSE
0653:GOTO 0620
0655 IF _OBJ_TYPE$="A" THEN LET _DRAGON_CNT=_DRAGON_CNT+1,_DRAGON_FR_CTL$[_DRAG
0655:ON_CNT]=_OBJ_NME$,_DRAGON_TO_CTL$[_DRAGON_CNT]=_OBJ_NULL$,_DRAGON_CTL[_DRA
0655:GON_CNT]=_DRAGON_CNT+19000; GOSUB CHECK_DEF_PRG; LET _DRAGON_CMD$[_DRAGON_
0655:CNT]=_OBJ_SEL$; GOTO 0620
0660 IF _OBJ_SEC$<>"" THEN CALL "*secure",_OBJ_SEC$; IF _OBJ_SEC$="" THEN LET _
0660:OBJ_STS$=_OBJ_STS$+"h" ! Hide forever
0670 IF _OBJ_SEC$="V" THEN IF _OBJ_TYPE$="M" THEN LET _OBJ_STS$=_OBJ_STS$+"L" E
0670:LSE LET _OBJ_STS$=_OBJ_STS$+"D"
0680 IF POS(_OBJ_TYPE$="BRC3LDVXM|_GH") THEN GOSUB GET_ID
0690 SETERR 0800
0700 IF POS("="=_OBJ_MSG$)=1 THEN LET _OBJ_MSG$=EVS(_OBJ_MSG$(2))
0710 LET _OBJ_C*=_ADJ_C,_OBJ_W*=_ADJ_W,_OBJ_L*=_ADJ_L,_ORIG_H=_OBJ_H,_OBJ_H*=_A
0710:DJ_H
0730 ON POS(_OBJ_TYPE$="ITFBRC3LDVXM|_xSEG(O/)^[H") GOSUB 0762,DISP_IMG,DISP_TX
0730:T,DISP_FNT,DISP_BTN,DISP_RBT,DISP_CBX,DISP_TRI,DISP_LBX,DISP_DBX,DISP_VBX,
0730:DISP_VDX,DISP_MLN,DISP_VSB,DISP_HSB,DISP_BOX,FLDR_INIT,EXT_INIT,DISP_GRID,
0730:DISP_ARC,DISP_CIRCLE,DISP_LINE,DISP_PIE,DISP_POLYGON,DISP_RECTANGLE,DISP_C
0730:HART
0740 SETERR SYS_ERR
0750 IF KEC(%SCR_LIB)<>_OBJ_K$ THEN READ (%SCR_LIB,KEY=_OBJ_K$,ERR=0620)*
0760 GOTO 0620
0762 IF MNU_LN$="" THEN IF POS("M":_PANEL_ATR$)=0 OR _F_CNT>0 THEN GOTO 0770
0763 IF MNU_LN$="" THEN IF _SCR_H_ID$<>"" AND _SCR_H_FL$<>"" THEN LET MNU_LN$="
0763:-[&Help=-5]"; GOTO 0769 ELSE GOTO 0770
0766 IF MNU_LN$(1,1)="-" THEN GOTO 0769
0767 LET _XX0=POS("]"=MNU_LN$); LET _XX1=POS("&HELP"=UCS(MNU_LN$(1,_XX0)))
0768 IF _SCR_H_ID$<>"" AND _SCR_H_FL$<>"" AND _XX1=0 THEN LET MNU_LN$="-"+MNU_L
0768:N$(1,_XX0-1)+",&Help=-5"+MNU_LN$(_XX0) ELSE LET MNU_LN$="-"+MNU_LN$
0769 MENU_BAR -1000,MNU_LN$
0770 LET _X$=CHG(_VAR_LST$)
0780 LET TAB_TABLE$=SRT(TAB_TABLE$,10)
0781 IF _QLST_IDX>_QLST_MAIN_PNL_IDX THEN GOSUB SETUP_SMART_LBX_IOLISTS
0783 PRECISION _SCR_PRC
0790 RETURN
0800 ! ^100 - Load error
0810 IF POS(_OBJ_TYPE$="BRC3LDVXM|_") THEN LET _ID$=SEP+"CTL value:"+STR(ID) EL
0810:SE LET _ID$=""
0820 MSGBOX "Error in definition of screen item:"+_OBJ_K$+SEP+MSG(ERR)+SEP+SEP+
0820:"Name:"+_OBJ_NME$+" @("+STR(_OBJ_C)+","+STR(_OBJ_L)+")"+_ID$+SEP+"["+STR(T
0820:CB(5))+"]","Screen Manager","!,BEEP"
0825 PRECISION _SCR_PRC
0830 RETURN
0840 IF INIT_TEXT$(LEN(INIT_TEXT$))=":" THEN LET INIT_TEXT$=EVS(INIT_TEXT$(2,LE
0840:N(INIT_TEXT$)-2),ERR=0800)+":"; GOTO 0650
0850 GOTO 0800
1000 ! 1000 - Position to tab
1005 NXT_INP: IF _LOAD_FLAG THEN PRINT 'SWAP','POP','SHOW'(2),; LET _LOAD_FLAG=
1005:0
1010 IF _DEPENDS_CNT>0 THEN GOSUB DEPENDS_CHK
1011 IF %NOMAD_SCRIPT_FN<>0 THEN GOSUB DO_SCRIPT
1012 IF _F_ID<>0 AND _CUR_ID=_F_ID THEN LET _F_I=_F_ACTV; GOTO FLDR_FOCUS
1013 PRINT '+U','C0',; OBTAIN (0,SIZ=1,TIM=0,ERR=*NEXT)'ME',*,'MN'; GOTO 1121
1014 SET_FOCUS READ _X; OBTAIN (0,SIZ=1,TIM=.1,ERR=*NEXT)'ME',*,'MN'; GOTO 1121
1015 IF _X<>0 THEN LET _CUR_ID=_X; GOTO GET_INP
1016 IF _CUR_ID<10000 OR _CUR_ID>10200 THEN GOTO FIND_CUR_ID ELSE IF _FCS_TBL$[
1016:_CUR_ID-10000]="" THEN SET_FOCUS _CUR_ID,ERR=FIND_CUR_ID; GOTO GET_INP
1017 LET _CUR_ID'ONFOCUSCTL=0; SET_FOCUS _CUR_ID,ERR=*NEXT; LET _CUR_ID'ONFOCUS
1017:CTL=_CUR_ID+5000; GOTO GET_INP
1018 LET _CUR_ID'ONFOCUSCTL=_CUR_ID+5000; GOTO FIND_CUR_ID
1040 FIND_CUR_ID: IF TAB_TABLE$<>"" THEN LET _TAB_DIR=1; GOTO 1300
1050 LET _X=_ID_LST
1051 LET _X=_X-1; IF _X<0 THEN PRINT 'RB',; GOTO GET_INP
1060 LET _CUR_ID=_CUR_ID+1; IF _CUR_ID>10000+_ID_LST THEN LET _CUR_ID=10001
1070 SET_FOCUS _CUR_ID,ERR=1051
1071 GOTO 1100
1100 ! ^100 - Get input
1101 GET_INP:
1105 IF _QLST_IDX>0 THEN GOSUB LOAD_AUTO_LISTS
1109 IF %Z__TMP_RSZ$<>"" THEN IF _RESIZE=0 THEN LET %Z__TMP_RSZ$="" ELSE PERFOR
1109:M "*winproc.rsz;Process_tmp_rsz"
1110 IF QRY_PENDING THEN OBTAIN (0,SIZ=1,TIM=0,ERR=1760)'ME',*,'MN'; GOTO 1130
1120 IF %NOMAD_TIMEOUT=0 THEN OBTAIN (0,SIZ=1)'ME',*,'MN' ELSE OBTAIN (0,SIZ=1,
1120:TIM=%NOMAD_TIMEOUT,ERR=END_OBJ_TIMEOUT)'ME',*,'MN'
1121 WAIT 0
1130 LET _EOM$=""
1140 IF EOM=$00027B$ AND NOT(%NOMADS_DISABLE_TRACE) THEN GOTO TRACE_INFO
1141 IF EOM=$00027A$ AND NOT(%NOMADS_DISABLE_DEBUG) THEN PRINT 'DIALOGUE'(0,0,8
1141:0,25,"Debug window",'MODE'($000B$)+'CS'),'SR',; ESCAPE ; PRINT 'POP',; GOT
1141:O NXT_INP
1142 IF CTL=0 AND EOM=$0D$ AND _DEF_K$="" THEN GOTO NXT_INP
1143 ! if eom=$000270$ then perform "*office"; goto NXT_INP
1144 IF EOM=$00037B$ THEN CALL "*winproc;Start_script"; GOTO NXT_INP
1145 IF EOM=$00037A$ THEN CALL "*winproc;Make_script"; GOTO NXT_INP
1146 IF CTL=-1980 THEN CALL "*winproc;End_script"; GOTO NXT_INP
1150 IF %DBG_FL THEN PRINT (%DBG_FL)"<Nomads>",_SCREEN_K$,":Receive event",CTL
1151 IF CTL<>_FORCE_FCS THEN LET _FORCE_FCS=100000 ELSE LET _FORCE_FCS=100000;
1151:GOTO NXT_INP
1160 IF CTL=-5 THEN GOTO 1400
1170 IF CTL=-6 THEN GOTO 1600
1175 IF CTL=-1999 AND EOM=$0080F831$ AND %NOMAD_ESC_SEL THEN LET CHANGE_FLG=CHA
1175:NGE_FLG+1
1177 IF CTL=-1083 THEN LET _ID=0; GOTO BUILD_POPUP_MNU ! popup menu for panel
1180 IF CTL=-1999 OR EOM=ESC THEN GOTO END_OBJ_LOG
1190 IF CTL=-1015 THEN LET _TAB_DIR=1; GOTO 1300
1200 IF CTL=-1016 THEN LET _TAB_DIR=-1; GOTO 1300
1201 IF CTL=-1011 OR CTL=-1012 THEN GOTO SPIN_CHK
1210 IF CTL=-1010 AND TAB_TABLE$<>"" THEN LET _X=NUM(TAB_TABLE$(LEN(TAB_TABLE$)
1210:-4)),_TAB_DIR=1; GOTO GOTO_NXT
1220 IF CTL=-1018 AND TAB_TABLE$<>"" THEN LET _X=NUM(TAB_TABLE$(6,5)),_TAB_DIR=
1220:-1; GOTO GOTO_NXT
1222 IF CTL=-1105 AND _RESIZE THEN LET _X$=OBJ(0),_X1=DEC($00$+_X$(33,2)),_X2=D
1222:EC($00$+_X$(35,2)); IF _X1=_SV_PNL_W AND _X2=_SV_PNL_H THEN GOTO NXT_INP E
1222:LSE IF _RESIZE=1 OR (_X1>=_ORIG_OBJ_W AND _X2>=_ORIG_OBJ_H) THEN PERFORM "
1222:*winproc.rsz;Resize"; GOTO NXT_INP ELSE LET _X1=MAX(_X1,_ORIG_OBJ_W),_X2=M
1222:AX(_X2,_ORIG_OBJ_H+_CST_ADJ); PRINT 'SIZE'(_X1,_X2),; GOTO NXT_INP
1230 IF CTL=-1200 THEN GOTO HELP_REQ
1231 IF _F_CNT>0 THEN IF EOM=$000209$ OR EOM=$000221$ OR EOM=$000321$ THEN LET
1231:_F_I=_F_ACTV,_F_DIR=1; GOTO FLDR_NEXT
1232 IF _F_CNT>0 THEN IF EOM=$000309$ OR EOM=$000222$ OR EOM=$000322$ THEN LET
1232:_F_I=_F_ACTV,_F_DIR=-1; GOTO FLDR_NEXT
1240 IF CTL=0 AND EOM=$0D$ THEN LET _TAB_DIR=1; IF _DEF_K$<>"" THEN SET_FOCUS _
1240:DEF_ID,ERR=1300; PREINPUT NEXT _DEF_ID; LET _CUR_ID=_DEF_ID; GOTO NXT_INP
1240:ELSE GOTO 1300
1250 GOTO 1800
1300 ! ^100 - Tab logic
1310 GOTO_TAB:
1313 IF NOT(CTL_ENABLED) AND NOT(%NOMAD_MAS90_FOCUS) THEN GOTO 1316
1315 IF _F_ID=0 OR _CUR_ID<>_F_ID THEN LET _X$=MSE,_CUR_ID=DEC(_X$(20,2))
1316 LET _X=_CUR_ID
1317 GOTO_NXT:
1320 LET _TC=LEN(TAB_TABLE$)/10,_TX=_TC
1330 IF _TC=0 THEN GOTO NXT_INP
1340 LET _T=POS(STR(_X:"00000")=TAB_TABLE$(6),10); IF _T<>0 THEN LET _T=(_T+9)/
1340:10
1352 LET _TX=_TX-1; IF _TX<0 THEN PRINT 'RB',; GOTO NXT_INP
1355 LET _T=_T+_TAB_DIR; IF _T>_TC THEN LET _T=1 ELSE IF _T<1 THEN LET _T=_TC
1356 IF _TAB_DIR=1 AND TAB_TABLE$(_T*10-5,1)="S" THEN GOTO 1355
1360 LET _X=NUM(TAB_TABLE$(_T*10-4,5))
1370 IF _F_ID=0 OR _X<>_F_ID THEN SET_FOCUS _X,ERR=1350
1373 LET _CUR_ID=_X; GOTO NXT_INP
1400 ! ^100 - Help
1410 HELP_REQ:
1420 LET _X$=MSE; IF CTL=-1200 THEN LET ID=DEC(_X$(23,2)) ELSE LET ID=DEC(_X$(2
1420:0,2))
1430 LET _CUR_ID=ID,_X$=""; IF ID>10000 AND ID<=10000+_ID_LST THEN LET _X$=_HLP
1430:_TBL$[ID-10000]
1440 IF _X$="" THEN LET ID=0
1450 GOSUB DO_HELP; GOTO NXT_INP
1500 ! ^100 - Process help
1510 DO_HELP:
1520 GOSUB GET_HELP
1525 IF NOT(_EXTERNAL_HELP) THEN LET _H_FL$="'"+_H_FL$
1530 IF _H_FL$="" THEN MSGBOX "Sorry.."+SEP+"There is no help specified for thi
1530:s input field","Help Sub-system","INFO"; RETURN
1550 SYSTEM_HELP _H_FL$,_H_ID$,ID,ERR=1570
1560 RETURN
1570 MSGBOX "Invalid Help definition","Help Sub-system","!"; RETURN
1600 ! ^100 - Query
1601 IF _F_ID<>0 AND _CUR_ID=_F_ID THEN LET _Q$=""; GOTO 1630
1610 LET QRY_PENDING=0,_X$=MSE,_X=DEC(_X$(20,2)),_Q$=""; IF _X>10000 AND _X<=10
1610:000+_ID_LST THEN LET _Q$=_QRY_TBL$[_X-10000]
1620 IF POS("="=_Q$)=1 THEN LET _Q$=EVS(_Q$(2),ERR=1630)
1630 IF _Q$="" THEN MSGBOX "Sorry.."+SEP+"There is no query available for this
1630:input field","Query Sub-system","!"; GOTO NXT_INP
1640 PRINT 'CI',
1650 LET _CUR_ID=_X,QRY_VAL$=""; MULTI_LINE READ _CUR_ID,QRY_VAL$,ERR=*NEXT
1660 LET ID=_X,ID$=_NAME_TBL$[ID-10000],_QRY_VAL$=QRY_VAL$
1663 LET _X$=ID$+_SFX$; IF _TYPE_TBL$[ID-10000]="#" THEN LET QRY_VAL.OLD_RAW=VI
1663:N(_X$(1,LEN(_X$)-1)),QRY_VAL.OLD$=STR(QRY_VAL.OLD_RAW) ELSE LET QRY_VAL.OL
1663:D_RAW$=VIS(_X$),QRY_VAL.OLD$=QRY_VAL.OLD_RAW$
1665 LET _OBJ_OUT$=_OUT_TBL$[ID-10000]; IF _OBJ_OUT$<>"" THEN LET _OBJ_TAG$=EVS
1665:(_NAME_TBL$[ID-10000]+".tag$"); LET _X$=QRY_VAL.OLD$; GOSUB OUT_PROC; LET
1665:QRY_VAL.OLD$=_X$
1670 IF %DBG_FL THEN PRINT (%DBG_FL)"<Nomads>",_SCREEN_K$,":Invoke query for ",
1670:ID$," Qry=",_Q$
1671 LET NEXT_ID=-1
1675 IF _Q$(1,1)="^" THEN GOSUB DO_SPINER; GOTO 1710
1680 IF _Q$(1,1)="*" THEN PERFORM _Q$(2),ERR=1000; GOTO 1710
1690 LET _Q=POS(",;":_Q$); IF _Q=0 THEN LET _QL$="" ELSE LET _QL$=_Q$(_Q+1),_Q$
1690:=_Q$(1,_Q-1)
1695 IF %NOMAD_QRY_CLEAR_START THEN LET SV_QRY_VAL$=QRY_VAL$,QRY_VAL$=""
1700 SET_PARAM 'TU'=_SV_TU; CALL "*winproc",_Q$,_QL$,QRY_VAL$; SET_PARAM 'TU'
1705 IF %NOMAD_QRY_CLEAR_START AND QRY_VAL$="" THEN LET QRY_VAL$=SV_QRY_VAL$
1710 SET_FOCUS READ _X; IF ID'ENABLED=0 THEN GOTO 1719 ! multi_line is disabled
1711 IF _X=ID THEN GOTO 1719
1712 IF _FCS_TBL$[_CUR_ID-10000]<>"" THEN MULTI_LINE SET_FOCUS ID,0
1713 IF QRY_VAL$<>_QRY_VAL$ THEN SET_FOCUS RETRY ID ELSE SET_FOCUS ID
1714 IF _FCS_TBL$[_CUR_ID-10000]<>"" THEN MULTI_LINE SET_FOCUS ID,ID+5000
1719 IF QRY_VAL$="" OR QRY_VAL$=_QRY_VAL$ THEN GOTO 1000
1720 MULTI_LINE WRITE ID,QRY_VAL$,ERR=1745
1730 LET CHANGE_FLG=CHANGE_FLG+1-EVN(ID$+".nochange")
1740 PREINPUT NEXT ID
1745 SET_FOCUS ID,ERR=*NEXT
1750 LET _CUR_ID=ID; GOTO NEXT_ID_CHK
1760 LET _X=QRY_PENDING,QRY_PENDING=0,_Q$=_QRY_TBL$[_X-10000]; GOTO 1620
1761 ! ^100 - Spiner
1762 DO_SPINER:
1763 READ DATA FROM _Q$(2) TO IOL=1769; IF _MAX<_MIN THEN LET _V=_MAX,_MAX=_MIN
1763:,_MIN=_V
1764 IF _INC=0 THEN LET _INC=1
1765 V_SCROLLBAR READ ID+3000,_X,3,1,1; V_SCROLLBAR WRITE ID+3000,2,3
1766 LET _V=NUM(QRY_VAL$); IF _X>2 THEN LET _V=_V-_INC ELSE LET _V=_V+_INC
1767 IF _MAX<>_MIN THEN LET _V=MIN(_MAX,MAX(_MIN,_V))
1768 LET QRY_VAL$=STR(_V); RETURN
1769 IOLIST _INC:[CHR(",")],_MAX:[CHR(",")],_MIN:[CHR("")]
1770 ! ^100 - Spin_chk
1771 SPIN_CHK:
1772 LET _ID=DEC($00$+MID(MSE,20,2))-10000; IF _ID<1 OR _ID>_ID_LST THEN GOTO U
1772:SER_CTL_CHK
1773 LET _Q$=_QRY_TBL$[_ID]; IF MID(_Q$,1,1)<>"^" THEN GOTO USER_CTL_CHK
1774 IF CTL=-1011 THEN LET _X=1 ELSE LET _X=3
1776 V_SCROLLBAR WRITE _ID+13000,_X,3
1777 GOTO 1600
1800 ! ^100 - See if known code
1810 IF CTL>10000 AND CTL<=10000+_ID_LST THEN LET _ID=CTL-10000; GOTO 2200
1820 IF CTL>15000 AND CTL<=15000+_ID_LST THEN LET _ID=CTL-15000; GOTO 2600
1830 IF CTL>11000 AND CTL<=11000+_F_CNT THEN GOTO FLDR_MOUSED
1840 IF CTL>12000 AND CTL<=12000+_EXT_CNT THEN LET CMD_STR$=_EXT_CMD$[CTL-12000
1840:]; GOSUB 7000; GOTO NXT_INP
1841 IF CTL>17000 AND CTL<17999 THEN GOTO MENU_SELECT
1850 IF CTL>18000 AND CTL<18999 THEN LET _ID=CTL-18000; GOTO BUILD_POPUP_MNU
1860 IF CTL>13000 AND CTL<=13000+_ID_LST THEN GOTO QRY_BTN
1863 IF CTL>19000 AND CTL<19999 THEN GOTO DRAG_CTL_CHK
1865 USER_CTL_CHK:
1870 LET _I=1
1880 IF _I>_USR_CNT THEN GOTO 1910
1890 IF CTL=_USR_CTL[_I] THEN LET CMD_STR$=_USR_CMD$[_I]; GOSUB 7000; GOTO NEXT
1890:_ID_CHK
1900 LET _I=_I+1; GOTO 1880
1910 IF CTL<0 AND CTL>-1000 THEN CALL "*control"; GOTO 1120
1920 IF CTL=1 THEN GOTO 1400
1921 LET ID=DEC($00$+MID(MSE,25,2)); IF ID>10000 AND ID<=10000+_ID_LST THEN LET
1921: ID$=_NAME_TBL$[ID-10000]
1925 IF %NOMADS_FKEY_HANDLER$<>"" THEN LET CMD_STR$=""; PERFORM %NOMADS_FKEY_HA
1925:NDLER$,ERR=1940; IF CMD_STR$<>"" THEN GOSUB 7000; GOTO NEXT_ID_CHK
1930 IF CTL=4 OR CTL=-1900 THEN GOTO END_OBJ_LOG
1950 GOTO NXT_INP
1960 ! ^100
1970 END_OBJ_TIMEOUT:
1980 IF ERR<>0 THEN GOTO END_OBJ ELSE PREINPUT NEXT -1900; GOTO GET_INP
2000 ! ^100 - Query Button
2010 QRY_BTN:
2011 LET _CUR_ID=CTL-3000
2020 ! ET_FOCUS _CUR_ID,ERR=2030
2030 LET QRY_PENDING=_CUR_ID ! Save Qry id
2040 LET _X$=""
2041 SET_FOCUS READ _X; IF _X=_CUR_ID THEN PREINPUT NEXT -6; GOTO GET_INP
2042 SET_FOCUS _CUR_ID,ERR=*NEXT ! switch to control and force focus event
2043 SET_FOCUS READ _X ! Give Windx time
2045 IF _FCS_TBL$[_CUR_ID-10000]<>"" THEN LET _X=_CUR_ID+5000,_X1=1.5 ELSE LET
2045:_X=99999,_X1=0
2050 OBTAIN (0,SIZ=1,TIM=_X1,ERR=*NEXT)'ME',*,'MN'; LET _X$=_X$+BIN(CTL,2); IF
2050:_X=CTL THEN LET _X1=0; GOTO 2050 ELSE GOTO 2050
2060 LET _X$=_X$+BIN(-6,2)
2070 IF _X$<>"" THEN PREINPUT DEC(_X$(1,2)); LET _X$=_X$(3); GOTO 2070
2080 GOTO GET_INP
2100 ! ^100 - End object
2102 END_OBJ_LOG:
2103 IF %NOMAD_SCRIPT_LOG<>0 THEN PRINT (%NOMAD_SCRIPT_LOG,ERR=*NEXT)"-1999"
2110 END_OBJ:
2115 LET %NOMAD_EXIT_PNL=1
2120 IF _F_EXIT_CMD$<>"" THEN LET CMD_STR$=_F_EXIT_CMD$; GOSUB 7000
2130 IF IGNORE_EXIT<>0 OR IGNORE_EXIT$="Y" THEN LET IGNORE_EXIT$="",IGNORE_EXIT
2130:=0,%NOMAD_EXIT_PNL=0; GOTO NEXT_ID_CHK
2140 LET CMD_STR$=EXIT_CMD$; GOSUB 7000
2145 LET %NOMAD_EXIT_PNL=0
2150 IF IGNORE_EXIT<>0 OR IGNORE_EXIT$="Y" THEN LET IGNORE_EXIT$="",IGNORE_EXIT
2150:=0; GOTO NEXT_ID_CHK
2160 LET _F_EXIT_CMD$=""
2170 GOTO 9000
2200 ! ^100 - Process entry
2210 IF %DBG_FL THEN PRINT (%DBG_FL)"<Nomads>",_SCREEN_K$,":Object name=",_NAME
2210:_TBL$[_ID]
2220 LET ID=_ID+10000,_CUR_ID=ID,ID$=_NAME_TBL$[_ID],_OBJ_TYPE$=_TYPE_TBL$[_ID]
2220:,_EOM$="",_VALIDATOR_ON=0
2230 IF POS(_OBJ_TYPE$="LDVXM#GH")=0 THEN GOTO 2390
2235 IF _OBJ_TYPE$="H" THEN CHART READ ID,ID.DATASET,_EOM$,ERR=NXT_INP
2237 IF _OBJ_TYPE$="H" THEN LET _CHART_DATASET$=ID$+".dataset"; VIA _CHART_DATA
2237:SET$=ID.DATASET; GOTO 2260
2240 IF _OBJ_TYPE$<>"G" THEN LIST_BOX READ ID,_X$,_EOM$,ERR=*NEXT; GOTO 2260
2245 IF _OBJ_TYPE$="G" THEN LET _X$=""; GRID READ ID,ID.COLUMN,ID.ROW,_X$,_EOM$
2245:,ERR=NXT_INP
2247 IF _OBJ_TYPE$="G" THEN LET _GRID_ROW$=ID$+".row",_GRID_COL$=ID$+".column";
2247: VIA _GRID_ROW$=ID.ROW; VIA _GRID_COL$=ID.COLUMN; GOTO 2260
2250 LET _X$=""; LIST_BOX READ ID,_X,_EOM$,ERR=2420 ! Should not error
2260 IF _EOM$=ESC AND %NOMAD_ESC_SEL=0 THEN GOTO GET_INP ELSE LET CHANGE_FLG=CH
2260:ANGE_FLG+1-EVN(ID$+".nochange")
2261 IF POS(_EOM$=%NOMADS_FKEY_TBL$) THEN GOTO GET_INP
2270 LET _I$=_X$,_ERR$=""
2280 IF _INP_TBL$[_ID]<>"" THEN CALL _INP_TBL$[_ID],ERR=2320,_X$,_ERR$,EVS(ID$+
2280:".tag$"),EVS(ID$+_SFX$),_EOM$; IF _ERR$="" THEN LET _VALIDATOR_ON=1
2290 IF _ERR$="" THEN GOTO 2330
2300 IF NOT(NUL(_ERR$)) THEN MSGBOX _ERR$,"Input validation failure","!"
2302 IF %NOMADS_AUTO_QRY AND _QRY_TBL$[_ID]<>"" THEN PRINT 'CI',; PREINPUT NEXT
2302: _ID+13000; SET_FOCUS RETRY ID; GOTO GET_INP
2305 IF _I$<>_X$ THEN LIST_BOX WRITE ID,_X$ ! Reset value returned by validator
2310 LET QRY_PENDING=0; SET_FOCUS RETRY ID; PRINT 'CI',; GOTO GET_INP
2320 LET _ERR$="Input data incorrect"+SEP+SEP+MSG(ERR)+SEP+"["+STR(TCB(30))+"]"
2320:; GOTO 2300
2330 IF _VLD_TBL$[_ID]<>"" THEN GOSUB VALID_INP; IF _ERR$<>"" THEN GOTO 2300
2340 LET _V$=ID$+_SFX$; IF _OBJ_TYPE$<>"#" THEN LET PRIOR_VAL$=VIS(_V$); VIA _V
2340:$=_X$ ELSE LET _V$=STP(_V$,1,"$"),PRIOR_VAL=VIN(_V$); VIA _V$=NUM(_X$,ERR=
2340:2320)
2341 LET __X$=CHG(_V$)
2350 IF _OUT_TBL$[_ID]="" THEN GOTO 2420
2360 LET _OBJ_OUT$=_OUT_TBL$[_ID],_OBJ_TAG$=EVS(ID$+".tag$"); GOSUB OUT_PROC
2370 IF _X$<>_I$ THEN MULTI_LINE WRITE ID,_X$
2380 GOTO 2420
2390 IF _OBJ_TYPE$="C" THEN CHECK_BOX READ ID,_X$,ERR=2420; LET CHANGE_FLG=CHAN
2390:GE_FLG+1-EVN(ID$+".nochange"),_V$=ID$+_SFX$; VIA _V$=_X$
2400 IF _OBJ_TYPE$="3" THEN TRISTATE_BOX READ ID,_X$,ERR=2420; LET CHANGE_FLG=C
2400:HANGE_FLG+1-EVN(ID$+".nochange"); LET _V$=ID$+_SFX$; VIA _V$=_X$
2410 IF _OBJ_TYPE$="R" THEN RADIO_BUTTON READ ID,_X,ERR=2420; LET _X$=STR(_X),C
2410:HANGE_FLG=CHANGE_FLG+1-EVN(ID$+".nochange"),_V$=ID$+_SFX$; LET _X1=POS(STR
2410:(ID*1000+_X:"00000000")=_RBT_TBL$(2),9); IF _X1=0 THEN VIA _V$=STR(_X) ELS
2410:E VIA _V$=_RBT_TBL$(_X1,1)
2411 IF _OBJ_TYPE$="B" THEN LET _V$="_qlst_"+ID$,_X=EVN(_V$)+1; VIA _V$=_X
2420 IF %NOMAD_SCRIPT_LOG<>0 THEN PRINT (%NOMAD_SCRIPT_LOG,ERR=*NEXT)_NAME_TBL$
2420:[_ID],TBL(_OBJ_TYPE$="B","="+_X$,"")
2425 LET CMD_STR$=_CMD_TBL$[_ID],NEXT_ID=-1
2430 GOSUB 7000
2435 NEXT_ID_CHK:
2436 IF REPLACEMENT_SCRN$<>"" THEN GOTO END_OBJ
2437 IF REPLACEMENT_FOLDER$<>"" AND _F_ACTV<>0 THEN LET _F_I=_F_ACTV; GOSUB FLD
2437:R_DEACTIVE; LET _F_OBJ$[_F_I]=REPLACEMENT_FOLDER$,REPLACEMENT_FOLDER$="",N
2437:EXT_FOLDER=_F_I+11000; IF REPLACEMENT_TAB_TITLE$<>"" THEN LET _F_TXT$[_F_I
2437:]=REPLACEMENT_TAB_TITLE$,REPLACEMENT_TAB_TITLE$=""
2440 IF NEXT_FOLDER=-1 OR NEXT_FOLDER=0 THEN GOTO 2471
2450 IF NEXT_FOLDER<11001 OR NEXT_FOLDER>11000+_F_CNT THEN MSGBOX "Invalid NEXT
2450:_FOLDER value of "+STR(NEXT_FOLDER),"Error","!,BEEP"; GOTO 2471
2455 LET _XXX$=OBJ(NEXT_FOLDER); IF AND(_XXX$(3,2),$8000$)=$8000$ THEN GOTO 247
2455:1 ! DISABLED FOLDER
2460 LET _F_I=NEXT_FOLDER-11000,QRY_PENDING=0,_CUR_ID=0,_SV_NXID=NEXT_ID,NEXT_I
2460:D=-1; GOSUB FLDR_ACTIVE; IF NEXT_ID=-1 THEN LET NEXT_ID=_SV_NXID
2471 IF NEXT_ID$<>"" THEN LET NEXT_ID=VIN(NEXT_ID$),NEXT_ID$=""
2472 IF NEXT_ID<>-1 AND NO_FLUSH=0 THEN LET _XXX$=MSE; PRINT 'CI',
2475 LET NO_FLUSH=0
2480 IF NEXT_ID<>-1 THEN LET QRY_PENDING=0,_EOM$="",_CUR_ID=NEXT_ID; SET_FOCUS
2480:NEXT_ID,ERR=NXT_INP
2485 IF NEXT_ID<>-1 THEN SET_FOCUS READ _XX; GOTO NXT_INP
2490 IF _EOM$=$0D$ THEN LET _TAB_DIR=1; IF %NOMAD_ENTER_TAB<>0 THEN GOSUB DEPEN
2490:DS_CHK; GOTO 1300 ELSE IF _DEF_K$<>"" THEN SET_FOCUS _DEF_ID,ERR=1300; LET
2490: _CUR_ID=_DEF_ID; PREINPUT NEXT _DEF_ID; GOTO GET_INP
2491 GOTO NXT_INP
2600 ! ^100 - Set focus logic
2610 LET CMD_STR$=_FCS_TBL$[_ID],NEXT_ID=-1
2611 LET ID=_ID+10000,_CUR_ID=ID,ID$=_NAME_TBL$[_ID],_OBJ_TYPE$=_TYPE_TBL$[_ID]
2611:,_EOM$=""
2620 GOTO 2430
2700 ! ^100 - Output formatter
2710 OUT_PROC:
2720 CALL _OBJ_OUT$,ERR=BAD_OUT,_X$,_OBJ_TAG$
2730 RETURN
2740 BAD_OUT: MSGBOX "Formating routine '"+_OBJ_OUT$+"' has reported an error."
2740:+SEP+SEP+"Output being presented without conversion.",MSG(ERR),"!"; RETURN
2740:
2800 ! ^100 - Process validation
2810 VALID_INP:
2820 LET _V$=STP(_VLD_TBL$[_ID],1)+","
2830 IF _V$="" THEN LET _ERR$=_X$+" is not a valid input value"+SEP+SEP+"Valid
2830:values are:"+SEP+$09$+_VLD_TBL$[_ID]; RETURN
2840 LET _O=POS(","=_V$)
2850 LET _X1$=_V$(1,_O-1),_V$=_V$(_O+1)
2860 IF NUL(_X1$) THEN GOTO 2930 ELSE LET _O=POS("-"=_X1$(2)); IF _O=0 THEN GOT
2860:O 2930 ELSE LET _O=_O+1
2870 LET _X2$=_X1$(1,_O-1),_X3$=_X1$(_O+1)
2880 LET _X2=NUM(_X2$,ERR=2910),_X3=NUM(_X3$,ERR=2910)
2890 LET _X=NUM(_X$,ERR=2825) ! Skip non-numeric
2900 IF _X>=_X2 AND _X<=_X3 THEN RETURN ELSE GOTO 2825
2910 IF _X$>=_X2$ AND _X$<=_X3$ THEN RETURN
2920 GOTO 2825
2930 IF _X$=_X1$ THEN RETURN
2940 GOTO 2825
3000 ! 3000 - Display processes
3010 DISP_IMG:
3020 LET _G$=_CUR_IMG$+_OBJ_K$(13)
3030 IF _OBJ_GRP$<>"" THEN GOSUB DEF_GRP
3040 IF _F_IMAGES$<>"" THEN LET _F_IMAGES$=_F_IMAGES$+'IMAGE'(DELETE _G$)
3050 IF POS("H"=_OBJ_STS$) THEN PRINT 'IMAGE'(_G$),'IMAGE'(DISABLE _G$),
3051 IF POS("*"=_OBJ_STS$)=0 THEN GOTO 3060
3052 LET _X$=EVS(_OBJ_NME$+_SFX$); IF _X$<>"" THEN LET INIT_TEXT$=_X$ ELSE LET
3052:_X$=_OBJ_NME$+_SFX$; VIA _X$=INIT_TEXT$
3060 GOSUB ATTR_CHK; PRINT 'IMAGE'(_G$),'PICTURE'(@X(_OBJ_C),@Y(_OBJ_L),@X(_OBJ
3060:_C+_OBJ_W),@Y(_OBJ_L+_OBJ_H),INIT_TEXT$,NUM(_OBJ_ATTR$)-1),
3061 IF POS("*"=_OBJ_STS$)=0 THEN RETURN
3063 LET _DYNAPIC_CMD$[_DYNAPIC_CNT]="'image'("+QUO+_G$+QUO+")+'PICTURE'(@X("+S
3063:TR(_OBJ_C)+"),@Y("+STR(_OBJ_L)+"),@X("+STR(_OBJ_C+_OBJ_W)+"),@Y("+STR(_OBJ
3063:_L+_OBJ_H)+"),"+_OBJ_NME$+_SFX$+","+STR(NUM(_OBJ_ATTR$)-1)+")+'image'($$)"
3065 LET _DYNAPIC_VAR$[_DYNAPIC_CNT]=_OBJ_NME$+_SFX$
3067 LET _DYNAPIC_VAL$[_DYNAPIC_CNT++]=INIT_TEXT$
3070 RETURN
3100 ! ^100 - Text
3110 DISP_TXT:
3120 GOSUB ATTR_CHK; PRINT _OBJ_ATTR$,@(INT(_OBJ_C),INT(_OBJ_L)),INIT_TEXT$,'RM
3120:',
3130 RETURN
3200 ! ^100 - Fonted text
3210 DISP_FNT:
3215 IF POS("h"=_OBJ_STS$)<>0 THEN RETURN
3220 LET _G$=_CUR_IMG$+_OBJ_K$(13)
3230 IF _OBJ_GRP$<>"" THEN GOSUB DEF_GRP
3240 LET _I1$='IMAGE'(_G$),_I2$=""
3250 IF _F_IMAGES$<>"" THEN LET _F_IMAGES$=_F_IMAGES$+'IMAGE'(DELETE _G$)
3260 IF POS("H"=_OBJ_STS$) THEN PRINT _I1$,'IMAGE'(DISABLE _G$),
3270 GOSUB ATTR_CHK
3280 IF _OBJ_W*_OBJ_H=0 THEN PRINT _I1$,_OBJ_ATTR$,'TEXT'(@X(_OBJ_C),@Y(_OBJ_L)
3280:,INIT_TEXT$),'RM',_I2$,; RETURN
3290 PRINT _I1$,_OBJ_ATTR$,'TEXT'(@X(_OBJ_C),@Y(_OBJ_L),@X(_OBJ_C+_OBJ_W),@Y(_O
3290:BJ_L+_OBJ_H),INIT_TEXT$),'RM',_I2$,
3300 RETURN
3400 ! ^100 - Button
3410 DISP_BTN:
3420 IF _DEF_K$="" AND _OBJ_DEF$="1" THEN LET _DEF_K$=_OBJ_K$,_DEF_ID=ID
3421 IF _DEF_K$<>_OBJ_K$ THEN GOTO 3440
3422 LET _G$=_CUR_IMG$+_OBJ_K$(13)
3423 IF _OBJ_GRP$<>"" THEN GOSUB DEF_GRP
3424 LET _I1$='IMAGE'(_G$)
3425 IF POS("H"=_OBJ_STS$) THEN PRINT _I1$,'IMAGE'(DISABLE _G$),
3427 IF _F_IMAGES$<>"" THEN LET _F_IMAGES$=_F_IMAGES$+'IMAGE'(DELETE _G$)
3430 PRINT 'IMAGE'(_G$),'PEN'(1,2,0),'RECTANGLE'(@X(_OBJ_C)-2,@Y(_OBJ_L)-2,@X(_
3430:OBJ_C+_OBJ_W)+2,@Y(_OBJ_L+_OBJ_H)+2),
3440 IF _OBJ_DSP$<>"" THEN GOSUB LOAD_LOGIC
3445 GOSUB POPUP_SETUP
3450 BUTTON ID,@(_OBJ_C,_OBJ_L,_OBJ_W,_OBJ_H)=INIT_TEXT$,MSG=_OBJ_MSG$,OPT=_OBJ
3450:_STS$,TIP=_OBJ_TIP$,FNT=_OBJ_FONT$,MNU=MNU_ID
3453 GOSUB SET_COLOURS
3455 IF SSN>"0401a" AND _OBJ_FCS$<>"" THEN GOSUB FOCUS_SETUP; BUTTON SET_FOCUS
3455:ID,ID+5000
3460 LET _QLST_BTN$+=_OBJ_NME$+"$,"
3470 RETURN
3500 ! ^100 - Check Box
3510 DISP_CBX:
3515 GOSUB POPUP_SETUP
3520 CHECK_BOX ID,@(_OBJ_C,_OBJ_L,_OBJ_W,_OBJ_H)=INIT_TEXT$,MSG=_OBJ_MSG$,OPT=_
3520:OBJ_STS$,TBL=_OBJ_TBL$,TIP=_OBJ_TIP$,FNT=_OBJ_FONT$,MNU=MNU_ID
3525 GOSUB SET_COLOURS
3530 IF _OBJ_DSP$<>"" THEN GOSUB LOAD_LOGIC
3540 IF SSN>"0401a" AND _OBJ_FCS$<>"" THEN GOSUB FOCUS_SETUP; CHECK_BOX SET_FOC
3540:US ID,ID+5000
3550 ! IF _OBJ_SEC$="V" THEN CHECK_BOX DISABLE ID
3560 IF INIT_VAL$<>"" THEN CHECK_BOX WRITE ID,INIT_VAL$,ERR=SET_ERR
3570 RETURN
3600 ! ^100 - tristate Box
3610 DISP_TRI:
3615 GOSUB POPUP_SETUP
3620 TRISTATE_BOX ID,@(_OBJ_C,_OBJ_L,_OBJ_W,_OBJ_H)=INIT_TEXT$,MSG=_OBJ_MSG$,OP
3620:T=_OBJ_STS$,TBL=_OBJ_TBL$,TIP=_OBJ_TIP$,FNT=_OBJ_FONT$,MNU=MNU_ID
3625 GOSUB SET_COLOURS
3630 IF _OBJ_DSP$<>"" THEN GOSUB LOAD_LOGIC
3640 IF SSN>"0401a" AND _OBJ_FCS$<>"" THEN GOSUB FOCUS_SETUP; TRISTATE_BOX SET_
3640:FOCUS ID,ID+5000
3650 ! IF _OBJ_SEC$="V" THEN TRISTATE_BOX DISABLE ID
3660 IF INIT_VAL$<>"" THEN TRISTATE_BOX WRITE ID,INIT_VAL$,ERR=SET_ERR
3670 RETURN
3700 ! ^100 - Radio button
3710 DISP_RBT:
3715 GOSUB POPUP_SETUP
3720 RADIO_BUTTON ID:_OBJ_IDX,@(_OBJ_C,_OBJ_L,_OBJ_W,_OBJ_H)=INIT_TEXT$,MSG=_OB
3720:J_MSG$,OPT=_OBJ_STS$,TIP=_OBJ_TIP$,FNT=_OBJ_FONT$,MNU=MNU_ID
3725 GOSUB SET_COLOURS
3730 IF ID=_ID_LST+10000 THEN IF _OBJ_DSP$<>"" THEN GOSUB LOAD_LOGIC
3740 IF SSN>"0401a" AND _OBJ_FCS$<>"" THEN GOSUB FOCUS_SETUP; RADIO_BUTTON SET_
3740:FOCUS ID:_OBJ_IDX,ID+5000
3750 ! IF _OBJ_SEC$="V" THEN RADIO_BUTTON DISABLE ID:_OBJ_IDX
3755 IF _OBJ_TBL$<>"" THEN GOTO 3765
3760 IF _OBJ_IDX=NUM(INIT_VAL$,ERR=*NEXT) THEN RADIO_BUTTON ON ID:_OBJ_IDX
3761 RETURN
3765 LET _RBT_TBL$=_RBT_TBL$+_OBJ_TBL$(1,1)+STR(ID:"00000")+STR(_OBJ_IDX:"000")
3766 IF _OBJ_TBL$=INIT_VAL$ THEN RADIO_BUTTON ON ID:_OBJ_IDX
3770 RETURN
3800 ! ^100 - List box
3805 DISP_LBX:
3806 LET _FMT_LBX$=_OBJ_NULL$; IF _OBJ_LISTBOX_TYPE$="S" THEN LET _FMT_LBX$=""
3808 IF MID(_OBJ_DEF$,1,1)="q" THEN GOSUB SETUP_SMART_LBX ELSE LET _QLST_FLG=0
3810 GOSUB FILTER_ATTRIBUTES
3811 IF _QLST_FLG=1 THEN LET _OBJ_SEP$="" ELSE IF LEN(_OBJ_SEP$)>1 THEN LET _OB
3811:J_SEP$=STP(_OBJ_SEP$,3,"$"),_OBJ_SEP$=ATH(_OBJ_SEP$,ERR=*NEXT); GOTO 3813
3812 ! IF _OBJ_SEP$<>"" AND LEN(_OBJ_SEP$)>1 THEN LET _OBJ_SEP$=EVS(_OBJ_SEP$,E
3812:RR=*NEXT)
3814 GOSUB PARSE_FMT_LBX
3816 GOSUB POPUP_SETUP
3818 TRANSLATE _FMT_LBX$," ",","
3820 LIST_BOX ID,@(_OBJ_C,_OBJ_L,_OBJ_W,_OBJ_H),FNT=_OBJ_FONT$,MSG=_OBJ_MSG$,KE
3820:Y=_OBJ_HOTKEY$,OPT=_LST_ATTR$,TBL=_OBJ_TBL$,TIP=_OBJ_TIP$,FMT=_FMT_LBX$,SE
3820:P=PAD(_OBJ_SEP$,1,SEP),MNU=MNU_ID
3825 GOSUB SET_COLOURS
3830 IF _OBJ_DSP$<>"" THEN GOSUB LOAD_LOGIC
3840 IF _OBJ_FCS$<>"" THEN GOSUB FOCUS_SETUP; LIST_BOX SET_FOCUS ID,ID+5000
3850 IF INIT_TEXT$<>"" THEN LIST_BOX LOAD ID,INIT_TEXT$
3860 ! IF _OBJ_SEC$="V" THEN LIST_BOX DISABLE ID
3870 IF INIT_VAL$<>"" AND _QLST_FLG=0 THEN LIST_BOX WRITE ID,INIT_VAL$,ERR=SET_
3870:ERR
3880 RETURN
3900 ! ^100 - Drop box
3910 DISP_DBX:
3911 LET _FMT_LBX$=""
3913 GOSUB POPUP_SETUP
3915 IF MID(_OBJ_DEF$,1,1)="q" THEN GOSUB SETUP_SMART_LBX ELSE LET _QLST_FLG=0
3920 DROP_BOX ID,@(_OBJ_C,_OBJ_L,_OBJ_W,_OBJ_H),FNT=_OBJ_FONT$,MSG=_OBJ_MSG$,KE
3920:Y=_OBJ_HOTKEY$,OPT=_OBJ_STS$,TBL=_OBJ_TBL$,TIP=_OBJ_TIP$,MNU=MNU_ID
3925 GOSUB SET_COLOURS
3930 IF _OBJ_DSP$<>"" THEN GOSUB LOAD_LOGIC
3940 IF _OBJ_FCS$<>"" THEN GOSUB FOCUS_SETUP; DROP_BOX SET_FOCUS ID,ID+5000
3950 IF INIT_TEXT$<>"" THEN DROP_BOX LOAD ID,INIT_TEXT$
3960 ! IF _OBJ_SEC$="V" THEN DROP_BOX DISABLE ID
3970 IF INIT_VAL$<>"" AND _QLST_FLG=0 THEN DROP_BOX WRITE ID,INIT_VAL$,ERR=SET_
3970:ERR
3980 RETURN
4000 ! ^100 - VarList box
4010 DISP_VBX:
4013 LET _FMT_LBX$=_OBJ_NULL$; IF _OBJ_LISTBOX_TYPE$="S" THEN LET _FMT_LBX$=""
4014 IF MID(_OBJ_DEF$,1,1)="q" THEN GOSUB SETUP_SMART_LBX ELSE LET _QLST_FLG=0
4015 GOSUB FILTER_ATTRIBUTES
4017 GOSUB POPUP_SETUP
4020 VARLIST_BOX ID,@(_OBJ_C,_OBJ_L,_OBJ_W,_OBJ_H),FNT=_OBJ_FONT$,MSG=_OBJ_MSG$
4020:,KEY=_OBJ_HOTKEY$,OPT=_LST_ATTR$,TIP=_OBJ_TIP$,MNU=MNU_ID
4025 GOSUB SET_COLOURS
4030 IF _OBJ_DSP$<>"" THEN GOSUB LOAD_LOGIC
4040 IF _OBJ_FCS$<>"" THEN GOSUB FOCUS_SETUP; VARLIST_BOX SET_FOCUS ID,ID+5000
4050 IF INIT_TEXT$<>"" THEN VARLIST_BOX LOAD ID,INIT_TEXT$
4060 ! IF _OBJ_SEC$="V" THEN VARLIST_BOX DISABLE ID
4070 IF INIT_VAL$<>"" AND _QLST_FLG=0 THEN VARLIST_BOX WRITE ID,INIT_VAL$,ERR=S
4070:ET_ERR
4080 RETURN
4100 ! ^100 - Vardrop box
4110 DISP_VDX:
4111 LET _FMT_LBX$=""
4113 GOSUB POPUP_SETUP
4115 IF MID(_OBJ_DEF$,1,1)="q" THEN GOSUB SETUP_SMART_LBX ELSE LET _QLST_FLG=0
4120 VARDROP_BOX ID,@(_OBJ_C,_OBJ_L,_OBJ_W,_OBJ_H),FNT=_OBJ_FONT$,MSG=_OBJ_MSG$
4120:,KEY=_OBJ_HOTKEY$,OPT=_OBJ_STS$,TIP=_OBJ_TIP$,MNU=MNU_ID
4125 GOSUB SET_COLOURS
4130 IF _OBJ_DSP$<>"" THEN GOSUB LOAD_LOGIC
4140 IF _OBJ_FCS$<>"" THEN GOSUB FOCUS_SETUP; VARDROP_BOX SET_FOCUS ID,ID+5000
4150 IF INIT_TEXT$<>"" THEN VARDROP_BOX LOAD ID,INIT_TEXT$
4160 ! IF _OBJ_SEC$="V" THEN VARDROP_BOX DISABLE ID
4170 IF INIT_VAL$<>"" AND _QLST_FLG=0 THEN VARDROP_BOX WRITE ID,INIT_VAL$,ERR=S
4170:ET_ERR
4180 RETURN
4200 ! ^100 - Multi-line
4210 DISP_MLN:
4215 IF %NOMAD_ENTER_TAB=2 THEN PRINT '-E',
4217 GOSUB POPUP_SETUP
4220 IF _ORIG_H<=1 AND _OBJ_QRY$<>"" THEN IF _OBJ_QRY$(1,1)="^" THEN LET _OBJ_W
4220:=_OBJ_W-(2*_ADJ_W) ELSE LET _OBJ_W=_OBJ_W-(%NOMAD_QRY_WIDE*_ADJ_W)
4221 IF _OBJ_ATTR$="$" THEN LET _OBJ_STS$=_OBJ_STS$+"$"
4222 IF _OBJ_ATTR$="*" AND _OBJ_FONT$="" THEN LET _OBJ_FONT$="*"
4225 IF _OBJ_SEP$<>"" AND POS("$"=_OBJ_SEP$) AND LEN(_OBJ_SEP$)>1 THEN LET _OBJ
4225:_SEP$=ATH(_OBJ_SEP$,ERR=*NEXT); GOTO 4230
4227 IF _OBJ_SEP$<>"" AND LEN(_OBJ_SEP$)>1 THEN LET _OBJ_SEP$=EVS(_OBJ_SEP$,ERR
4227:=*NEXT)
4230 MULTI_LINE ID,@(_OBJ_C,_OBJ_L,_OBJ_W,_OBJ_H),LEN=_OBJ_IDX,FNT=_OBJ_FONT$,M
4230:SG=_OBJ_MSG$,KEY=_OBJ_HOTKEY$,FMT=INIT_TEXT$,OPT=_OBJ_STS$,NUL=_OBJ_NULL$,
4230:TIP=_OBJ_TIP$,SEP=PAD(_OBJ_SEP$,1,SEP),MNU=MNU_ID
4231 IF _ORIG_H>1 OR _OBJ_QRY$="" THEN GOTO 4248
4232 IF _OBJ_QRY$(1,1)="^" THEN LET _LINE=MAX(_OBJ_L-.25,0),_HEIGHT=_OBJ_H+.5;
4232:IF _LINE=0 THEN LET _HEIGHT=_OBJ_H+.25
4233 IF POS("L"=_OBJ_STS$) THEN LET _OBJ_STS$=STP(_OBJ_STS$,3,"D"); LET _OBJ_ST
4233:S$=_OBJ_STS$+"D"
4235 IF _OBJ_QRY$(1,1)="^" THEN V_SCROLLBAR ID+3000,@(_OBJ_C+_OBJ_W+.2,_LINE,1.
4235:8*_ADJ_W,_HEIGHT),OPT=TBL(POS("s":_OBJ_STS$)=0,"s","")+TBL(POS("D":_OBJ_ST
4235:S$)=0,"D","")+TBL(POS("H":_OBJ_STS$)=0,"H",""); LET _XXX$=OBJ(ID+3000); IF
4235: AND(_XXX$(3,2),$8000$)=$8000$ THEN GOTO 4248 ELSE V_SCROLLBAR WRITE ID+30
4235:00,2,3; GOTO 4248
4237 LET _OBJ_STS$=STP(_OBJ_STS$,3,"U"),_OBJ_STS$=STP(_OBJ_STS$,3,"T"),_OBJ_STS
4237:$=STP(_OBJ_STS$,3,"F"),_OBJ_STS$=STP(_OBJ_STS$,3,"B")
4240 BUTTON ID+3000,@(_OBJ_C+_OBJ_W,_OBJ_L,%NOMAD_QRY_WIDE*_ADJ_W,0-_OBJ_H)=%NO
4240:MAD_QRY_BTN$,OPT="S"+_OBJ_STS$+%NOMAD_QRY_ATTR$,TIP=%NOMAD_QRY_TIP$
4248 IF _OBJ_GRP$<>"" THEN LET _G$=BIN(ID+3000,2)+$00$; GOSUB DEF_GRP
4249 GOSUB SET_COLOURS; IF %NOMAD_ENTER_TAB=2 THEN PRINT '+E',
4250 IF _OBJ_DSP$<>"" THEN GOSUB LOAD_LOGIC
4260 IF _OBJ_FCS$<>"" THEN GOSUB FOCUS_SETUP; MULTI_LINE SET_FOCUS ID,ID+5000
4270 ! IF INIT_VAL$="" RETURN
4271 LET _X$=INIT_VAL$; IF _OBJ_OUT$<>"" THEN GOSUB OUT_PROC
4272 IF _X$<>"" THEN MULTI_LINE WRITE ID,_X$,ERR=SET_ERR
4280 RETURN
4300 ! ^100 - Vertcial Scroll bar
4310 DISP_VSB:
4320 V_SCROLLBAR ID,@(_OBJ_C,_OBJ_L,_OBJ_W,_OBJ_H),OPT=_OBJ_STS$
4330 IF _OBJ_DSP$<>"" THEN GOSUB LOAD_LOGIC
4340 ! IF _OBJ_FCS$<>"" THEN GOSUB FOCUS_SETUP; v_scrollbar SET_FOCUS ID,id+500
4340:0
4350 RETURN
4400 ! ^100 - Horizontal Scroll bar
4410 DISP_HSB:
4420 H_SCROLLBAR ID,@(_OBJ_C,_OBJ_L,_OBJ_W,_OBJ_H),OPT=_OBJ_STS$
4430 IF _OBJ_DSP$<>"" THEN GOSUB LOAD_LOGIC
4440 ! IF _OBJ_FCS$<>"" THEN GOSUB FOCUS_SETUP; H_scrollbar SET_FOCUS ID,id+500
4440:0
4450 RETURN
4500 ! ^100 - Box
4510 DISP_BOX:
4515 IF POS("h"=_OBJ_STS$)<>0 THEN RETURN
4520 GOSUB ATTR_CHK
4530 LET _G$=_CUR_IMG$+_OBJ_K$(13)
4540 IF _OBJ_GRP$<>"" THEN GOSUB DEF_GRP
4550 LET _I1$='IMAGE'(_G$),_I2$=""
4560 IF _F_IMAGES$<>"" THEN LET _F_IMAGES$=_F_IMAGES$+'IMAGE'(DELETE _G$)
4570 IF POS("H"=_OBJ_STS$) THEN PRINT 'IMAGE'(_G$),'IMAGE'(DISABLE _G$),
4580 IF _OBJ_DEF$="2" THEN PRINT _I1$,_OBJ_ATTR$,'FRAME'(@X(_OBJ_C),@Y(_OBJ_L),
4580:@X(_OBJ_C+_OBJ_W),@Y(_OBJ_L+_OBJ_H),-2,INIT_TEXT$),'RM',_I2$,; RETURN
4590 IF _OBJ_DEF$="3" THEN PRINT _I1$,_OBJ_ATTR$,'FRAME'(@X(_OBJ_C),@Y(_OBJ_L),
4590:@X(_OBJ_C+_OBJ_W),@Y(_OBJ_L+_OBJ_H),2,INIT_TEXT$),'RM',_I2$,; RETURN
4600 IF _OBJ_DEF$="4" THEN PRINT _I1$,_OBJ_ATTR$,'FRAME'(@X(_OBJ_C),@Y(_OBJ_L),
4600:@X(_OBJ_C+_OBJ_W),@Y(_OBJ_L+_OBJ_H),0,INIT_TEXT$),'RM',_I2$,; RETURN
4610 PRINT 'BOX'(INT(_OBJ_C),INT(_OBJ_L),INT(_OBJ_W),INT(_OBJ_H),INIT_TEXT$,_OB
4610:J_ATTR$),'RM',
4620 RETURN
4700 ! ^100 - Report error in Set of list
4710 SET_ERR: MSGBOX "Unable to set initial value for "+_OBJ_NME$+" @("+STR(_OB
4710:J_C)+","+STR(_OBJ_L)+")"+SEP+SEP+"Value that failed is:"+SEP+$09$+QUO+INIT
4710:_VAL$+QUO,"Load error","!"; RETURN
4800 ! ^100 - Menu_select
4810 MENU_SELECT:
4811 READ (%SCR_LIB,KEY=MAIN_SCRN_K$+"M"+STR(CTL-17000:"000"))IOL=8010
4812 GOSUB CHECK_DEF_PRG; LET CMD_STR$=_OBJ_SEL$; GOSUB 7000; GOTO NEXT_ID_CHK
5000 ! 5000 - Folder Focus
5010 FLDR_FOCUS: LET _F_DIR=1
5020 LET _X=_F_CNT+1
5030 IF _F_I>_F_CNT THEN LET _F_I=1 ELSE IF _F_I<1 THEN LET _F_I=_F_CNT
5040 LET _X=_X-1; IF _X<0 THEN PRINT 'RB',; GOTO 5080 ! Avoid endless loop
5050 SET_FOCUS 11000+_F_I,ERR=5060; GOTO 5080
5055 FLDR_NEXT: LET _X=_F_CNT+1
5060 LET _F_I=_F_I+_F_DIR; GOTO 5030
5070 SET_FOCUS 0
5080 LET _F_FCS=_F_I,NEXT_ID=-1; GOSUB FLDR_ACTIVE; IF NEXT_ID<>-1 THEN GOTO 52
5080:00
5085 IF _DEPENDS_CNT>0 THEN GOSUB DEPENDS_CHK
5090 SET_FOCUS 0
5095 LET QRY_PENDING=0
5100 OBTAIN (0,SIZ=1)'+U','SR','ME','C0','+F',*,'-F','MN'+_F_SR$
5110 ! if CTL=-1080 THEN GOTO 5100
5120 IF CTL=5 THEN GOTO 5100
5130 IF CTL=-1005 OR EOM=$000209$ OR EOM=$000221$ OR EOM=$000321$ THEN LET _F_I
5130:=_F_ACTV,_F_DIR=1; GOTO FLDR_NEXT
5140 IF CTL=-1004 OR EOM=$000309$ OR EOM=$000222$ OR EOM=$000322$ THEN LET _F_I
5140:=_F_ACTV,_F_DIR=-1; GOTO FLDR_NEXT
5141 IF CTL=11000+_F_ACTV THEN GOTO 5100
5142 IF CTL=-1000 THEN GOTO 5100
5150 LET _F_FCS=0,_X$=STR(_F_ID:"00000"); PRINT 'IMAGE'(DELETE "FldrFcs"),
5155 IF EOM=ESC THEN PREINPUT NEXT -1999; GOTO GET_INP
5160 IF CTL=0 AND EOM=$0D$ AND %NOMAD_ENTER_TAB THEN PREINPUT NEXT -1015; GOTO
5160:GET_INP
5190 IF CTL=-1104 THEN SET_FOCUS READ _CUR_ID ELSE PREINPUT NEXT CTL ! Ignore F
5190:ocus change
5191 GOTO GET_INP
5200 LET _F_FCS=0; PRINT 'IMAGE'(DELETE "FldrFcs"),; GOTO NEXT_ID_CHK
5300 ! ^100 - Initialize Folder region
5310 FLDR_INIT:
5311 PRINT 'IMAGE'(""),; GOSUB GET_XYINFO
5312 LET _FLDR_FONT$=_OBJ_FONT$; IF _FLDR_FONT$="" THEN LET _FLDR_FONT$="MS San
5312:s Serif,1,&C"
5313 IF _OBJ_COLOR$="" THEN LET _FLDR_COLOR$="" ELSE LET _FLDR_COLOR$='MODE'(AT
5313:H(_OBJ_COLOR$))
5314 LET _F_CLRTBL$=_OBJ_DEF$
5320 LET _F_CNT=POS($00$=INIT_TEXT$,1,0),[email protected](_OBJ_W)/_F_CNT,[email protected](_OBJ_L)
5320:,[email protected](_OBJ_L)[email protected](1.5),[email protected](_OBJ_H),[email protected](_OBJ_C),_F_CLR=DEC(MID(FI
5320:N(0),14,1))
5330 LET _OBJ_IDX=NUM(_OBJ_IDX$,ERR=5340); IF _OBJ_IDX<>0 THEN LET _F_W=MIN(@X(
5330:_OBJ_IDX),_F_W)
5340 LET _F_COL=_OBJ_C,_F_LN=_OBJ_L,_F_WD=_OBJ_W,_F_HI=_OBJ_H
5350 IF (_F_CLR>0 AND _F_CLR<7) OR (_F_CLR>8 AND _F_CLR<15) THEN LET _F_CLR=(_F
5350:_CLR+Cool|16
5360 LET _F_I=1,_X$=INIT_TEXT$
5370 LET _X=POS($00$=_X$); IF _X=0 THEN GOTO 5380
5372 LET _X1$=_X$(1,_X-1),_X$=_X$(_X+1)
5373 LET _X=POS("="=_X1$); LET _XXX=0; IF _X=1 THEN LET _X=POS("="=_X1$(_X+1)),
5373:_XXX=1
5374 LET _F_OBJ$[_F_I]=_X1$(1,_X+_XXX-1),_F_TXT$[_F_I]=_X1$(_X+1+_XXX)
5375 IF POS("="=_F_TXT$[_F_I])=1 THEN LET _F_TXT$[_F_I]=EVS(_F_TXT$[_F_I](2),ER
5375:R=*NEXT)
5376 IF POS("="=_F_OBJ$[_F_I])=1 THEN LET _F_OBJ$[_F_I]=EVS(_F_OBJ$[_F_I](2))
5377 LET _F_I=_F_I+1; GOTO 5370
5380 LET _F=2; SETMOUSE CLEAR ; FOR _F_I=1 TO _F_CNT; GOSUB 5500; NEXT
5390 LET _F_B1=_F_T+_F_H,[email protected](_OBJ_W)
5400 IF %NOMAD_WIN_VER>375 THEN PRINT 'PEN'(1,2,Cool,'LINE'(_F_X+2,_F_B1,_F_R,_F_
5400:B1,_F_R,_F_B+2),'PEN'(1,1,0),'LINE'(_F_X,_F_B1,_F_R,_F_B1,_F_R,_F_B),'PEN'
5400:(1,1,7),'LINE'(_F_X,_F_B1,_F_X,_F_B,_F_R,_F_B),; GOTO 5420
5410 PRINT 'PEN'(1,1,7),'FILL'(1,7),'POLYGON'(_F_X,_F_B1,_F_X+4,_F_B1-4,_F_X+4,
5410:_F_B+4,_F_R-4,_F_B+4,_F_R,_F_B,_F_X,_F_B),'PEN'(1,1,Cool,'FILL'(1,Cool,'POLYGO
5410:N'(_F_X,_F_B1,_F_X+4,_F_B1-4,_F_R-4,_F_B1-4,_F_R-4,_F_B+4,_F_R,_F_B,_F_R,_
5410:F_B1),'PEN'(1,1,0),'LINE'(_F_X,_F_B,_F_X,_F_B1+2,_F_R+2,_F_B1+2,_F_R+2,_F_
5410:B,_F_X,_F_B), ! 'FILL'(0,0),'RECTANGLE'(_F_X,_F_B,_F_R+2,_F_B1+2),
5420 LET _F_ACTV=0,_F_I=0,_FC_ADJ=.1,_FL_ADJ=.1
5430 IF NOT(_FLDR_SHUFFLE) THEN LET _ID_LST=_ID_LST+1,_F_ID=10000+_ID_LST
5431 IF POS("K"=_OBJ_STS$)<>0 THEN LET _X$="S" ELSE LET _X$=" "
5440 IF _OBJ_TAB<>0 THEN LET TAB_TABLE$=TAB_TABLE$+STR(_OBJ_TAB:"0000")+_X$+STR
5440:(_F_ID:"00000")
5450 RETURN
5500 ! ^100 - Display folder tab
5510 FLDR_DISP:
5520 LET _F_R=_F_X+_F_I*_F_W,_F_L=_F_R-_F_W,[email protected](1)
5530 IF %NOMAD_WIN_VER>375 THEN LET _B$="",_FUDGE=4 ELSE LET _B$="",_FUDGE=0
5540 IF _F_I=_F_ACTV THEN LET _F=4; PRINT 'SR','IMAGE'(DELETE "Active"),'IMAGE'
5540:("Active"),'FONT'(_FLDR_FONT$+_B$),; GOTO 5580 ELSE LET _FUDGE=0
5550 LET _X$="fldr."+STP(_F_OBJ$[_F_I],1)+".ctl"
5560 LET _X=11000+_F_I; VIA _X$=_X
5570 PRINT 'SR','FONT'(_FLDR_FONT$),; SETMOUSE @(_F_L/_A,_OBJ_L,_F_W/_A,(_F_B-_
5570:F_T)/_AT_Y1)=_X; SETMOUSE @(_F_L/_A,_OBJ_L,_F_W/_A,(_F_B-_F_T)/_AT_Y1):-10
5570:00; BUTTON _X,@(0,0,0,0)=_F_TXT$[_F_I],ERR=5590
5580 IF %NOMAD_WIN_VER>375 THEN LET _F_R=_F_R-2; PRINT 'PEN'(0,1,_F_CLR),'FILL'
5580:(1,_F_CLR),'RECTANGLE'(_F_L+2,_F_T,_F_R,_F_B+6),; GOTO 5600
5590 PRINT 'PEN'(1,1,_F_CLR),'FILL'(1,_F_CLR),'RECTANGLE'(_F_L+6,_F_T,_F_L+_F_W
5590:-4,_F_B+6),
5600 LET _C=NUM(MID(_F_CLRTBL$,_F_I*2-1,2))
5601 LET _F_TOP=_F_T; IF %NOMAD_WIN_VER>375 THEN LET _A=_A/4; IF _F_I=_F_ACTV T
5601:HEN LET _F_TOP=_F_TOP-4
5602 IF _C<>0 THEN IF %NOMAD_WIN_VER>375 THEN PRINT 'PEN'(0,0,0),'FILL'(1,_C-1)
5602:,'RECTANGLE'(_F_L,_F_TOP+2,_F_R,_F_B+2),'PEN'(1,1,0),'LINE'(_F_L,_F_B,_F_R
5602:,_F_B), ELSE PRINT 'PEN'(0,0,0),'FILL'(1,_C-1),'POLYGON'(_F_L,_F_B+4,_F_L,
5602:_F_TOP+_A,_F_L+_A,_F_TOP,_F_R-_A,_F_TOP,_F_R,_F_TOP+_A,_F_R,_F_B+4),'PEN'(
5602:1,1,0),'LINE'(_F_L,_F_B+4,_F_R,_F_B+4),
5609 PRINT _FLDR_COLOR$,'TEXT'(_F_L+_F_W/2,[email protected](.5)-_FUDGE,_F_TXT$[_F_I]),'R
5609:M',
5610 IF _F_FCS=_F_I THEN PRINT 'IMAGE'(DELETE "FldrFcs"),'IMAGE'("FldrFcs"),'FO
5610:NT'(_FLDR_FONT$+_B$+"F"),_FLDR_COLOR$,'TEXT'(_F_L+_F_W/2,[email protected](.5)-_FUDG
5610:E,_F_TXT$[_F_I]),'RM','IMAGE'("Active"),
5630 IF %NOMAD_WIN_VER>375 THEN PRINT 'PEN'(1,2,Cool,'LINE'(_F_R,_F_TOP+6,_F_R,_F
5630:_B-2),'PEN'(1,1,0),'LINE'(_F_R-4,_F_TOP,_F_R,_F_TOP+4,_F_R,_F_B),'PEN'(1,1
5630:,7),'LINE'(_F_L,_F_B,_F_L,_F_TOP+4,_F_L+4,_F_TOP,_F_R-4,_F_TOP),; GOTO 566
5630:0
5640 PRINT 'PEN'(1,1,7),'FILL'(1,7),'POLYGON'(_F_L,_F_B,_F_L+_F,_F_B,_F_L+_F,_F
5640:_TOP+_A+_F/2,_F_L+_A+_F/2,_F_TOP+_F,_F_R-_A-_F/2,_F_TOP+_F,_F_R-_A,_F_TOP,
5640:_F_L+_A,_F_TOP,_F_L,_F_TOP+_A,_F_L,_F_B),'PEN'(1,1,Cool,'FILL'(1,Cool,'POLYGON
5640:'(_F_R-_A,_F_TOP,_F_R,_F_TOP+_A,_F_R,_F_B,_F_R-_F+1,_F_B,_F_R-_F+1,_F_TOP+
5640:_A+_F/2,_F_R-_A-_F/2,_F_TOP+_F),
5650 PRINT 'PEN'(1,1,0),'LINE'(_F_L,_F_B,_F_L,_F_TOP+_A,_F_L+_A,_F_TOP,_F_R-_A,
5650:_F_TOP,_F_R,_F_TOP+_A,_F_R,_F_B),
5660 PRINT 'IMAGE'(""),
5670 RETURN
5700 ! ^100 - Set Active
5710 FLDR_ACTIVE:
5720 ! PRINT 'SR',
5730 IF _F_I=_F_ACTV AND %NOMADS_FOLDER_REDRAW=0 THEN GOTO FLDR_DISP
5740 IF _F_ACTV<>0 THEN GOSUB FLDR_DEACTIVE; IF %NOMAD_SCRIPT_LOG<>0 THEN PRINT
5740: (%NOMAD_SCRIPT_LOG,ERR=*NEXT)"*FOLDER="+STP(UCS(_F_OBJ$[_F_I]),2)
5745 PRINT 'SR',
5750 LET _F_ACTV=_F_I,%NOMADS_FOLDER_REDRAW=0
5760 GOSUB FLDR_DISP
5770 LET _FTAB_TABLE$=TAB_TABLE$,TAB_TABLE$=""
5780 IF _GRPS$<>"" THEN LET _X$=CPL("IOLIST "+_GRPS$(2)),_F_SVGRP$=REC(_X$)
5790 LET _F_GRPS$=_GRPS$,_GRPS$="",_F_DEF_K$=_DEF_K$,_F_DEF_ID=_DEF_ID
5800 LET _F_ID_LST=_ID_LST,_F_EXT_CNT=_EXT_CNT,_F_USR_CNT=_USR_CNT,_F_VAR_LST$=
5800:_VAR_LST$,_F_RBT_TBL$=_RBT_TBL$,_F_DYNAPIC_CNT=_DYNAPIC_CNT
5810 LET _F_SR$='SCROLL'(INT(_F_COL+.99),INT(_F_LN+2.99),INT(_F_WD),INT(_F_HI-2
5810:)); PRINT _F_SR$,'IMAGE'("ActiveFldr"),
5820 LET FOLDER_ID$=_F_OBJ$[_F_ACTV],SCRN_K$=PAD(FOLDER_ID$,12)
5830 READ (%SCR_LIB,KEY=SCRN_K$+"0000",DOM=5890)IOL=8010
5831 LET _F_HLP$=_OBJ_HLP$
5835 IF _OBJ_VALID$=WHO THEN GOSUB CHECK_TEST
5836 IF _OBJ_INP$="" THEN LET FLDR_DEFAULT_PROG$=DEFAULT_PROG$ ELSE IF _OBJ_INP
5836:$(1,1)="=" THEN LET FLDR_DEFAULT_PROG$=EVS(_OBJ_INP$(2)) ELSE LET FLDR_DEF
5836:AULT_PROG$=_OBJ_INP$
5837 GOSUB CHECK_DEF_PRG
5839 IF _OBJ_DSP$="" THEN GOTO 5850
5840 LET CMD_STR$=_OBJ_DSP$; GOSUB 7000; IF REPLACEMENT_FOLDER$<>"" THEN LET _F
5840:_OBJ$[_F_ACTV]=REPLACEMENT_FOLDER$,REPLACEMENT_FOLDER$=""; IF FOLDER_ID$<>
5840:_F_OBJ$[_F_ACTV] THEN GOTO 5820
5841 IF NEXT_FOLDER<>-1 THEN PREINPUT NEXT NEXT_FOLDER
5850 LET _F_EXIT_CMD$=_OBJ_SEL$,_F_DISP_CMD$=_OBJ_FCS$
5860 GOSUB ATTR_CHK; PRINT _OBJ_ATTR$,'-U',
5861 LET _QLST_IDX=_QLST_MAIN_PNL_IDX
5865 LET _FLDR_AUTO_CLOSE=0; IF POS("C"=_OBJ_NULL$) THEN LET _FLDR_AUTO_CLOSE=1
5867 IF _FLDR_RESIZE THEN PRECISION 2; LET _SV_ADJ_C=_ADJ_C,_ADJ_C=1; LET _SV_A
5867:DJ_W=_ADJ_W,_ADJ_W=1; LET _SV_ADJ_L=_ADJ_L,_ADJ_L=1; LET _SV_ADJ_H=_ADJ_H,
5867:_ADJ_H=1; PRECISION _SCR_PRC
5870 LET _CUR_IMG$="F_",_F_IMAGES$='IMAGE'(DELETE _CUR_IMG$); GOSUB DISP_SCRN
5871 IF _FLDR_RESIZE THEN LET _ADJ_C=_SV_ADJ_C,_SV_ADJ_C=0; LET _ADJ_W=_SV_ADJ_
5871:W,_SV_ADJ_W=0; LET _ADJ_L=_SV_ADJ_L,_SV_ADJ_L=0; LET _ADJ_H=_SV_ADJ_H,_SV_
5871:ADJ_H=0
5873 IF _FLDR_RESIZE THEN LET _SV_SCRN$=SCRN_K$; PRINT _F_IMAGES$,@(0,0),'CE',;
5873: LET _DYNAPIC_CNT=_F_DYNAPIC_CNT; PERFORM "*winproc.rsz;Resize_disp"
5875 IF _QLST_IDX>0 THEN GOSUB LOAD_AUTO_LISTS
5880 IF NOT(NUL(_IOL$)) THEN LET _F_INIT_IOL$=CPL("IOLIST "+_IOL$(2)),_F_INIT_V
5880:AL$=_VAL$
5890 LET _X=POS(STR(_F_ID:"00000")=_FTAB_TABLE$(6),10)
5900 LET TAB_TABLE$=_FTAB_TABLE$(1,_X+9)+TAB_TABLE$+_FTAB_TABLE$(_X+10)
5905 IF _F_DISP_CMD$<>"" THEN LET CMD_STR$=_F_DISP_CMD$; GOSUB 7000
5910 PRINT 'IMAGE'(""),
5920 RETURN
5950 ! ^50 - Check folder default program
5955 CHECK_DEF_PRG: LET _P$=FLDR_DEFAULT_PROG$
5956 IF _P$="" THEN LET _P$=DEFAULT_PROG$; IF _P$="" THEN RETURN
5957 IF LEN(_OBJ_INP$)>2 THEN IF _OBJ_INP$(1,1)=";" THEN LET _OBJ_INP$=_P$+_OBJ
5957:_INP$(1)
5958 IF LEN(_OBJ_OUT$)>2 THEN IF _OBJ_OUT$(1,1)=";" THEN LET _OBJ_OUT$=_P$+_OBJ
5958:_OUT$(1)
5960 IF LEN(_OBJ_DSP$)>3 THEN IF _OBJ_DSP$(1,3)="C"";" OR _OBJ_DSP$(1,3)="P"";"
5960: THEN LET _OBJ_DSP$=_OBJ_DSP$(1,2)+_P$+_OBJ_DSP$(3)
5965 IF LEN(_OBJ_FCS$)>3 THEN IF _OBJ_FCS$(1,3)="C"";" OR _OBJ_FCS$(1,3)="P"";"
5965: THEN LET _OBJ_FCS$=_OBJ_FCS$(1,2)+_P$+_OBJ_FCS$(3)
5970 IF LEN(_OBJ_SEL$)>3 THEN IF _OBJ_SEL$(1,3)="C"";" OR _OBJ_SEL$(1,3)="P"";"
5970: THEN LET _OBJ_SEL$=_OBJ_SEL$(1,2)+_P$+_OBJ_SEL$(3)
5973 IF LEN(_OBJ_POPUP_LOGIC$)>3 THEN IF _OBJ_POPUP_LOGIC$(1,3)="C"";" OR _OBJ_
5973:POPUP_LOGIC$(1,3)="P"";" THEN LET _OBJ_POPUP_LOGIC$=_OBJ_POPUP_LOGIC$(1,2)
5973:+_P$+_OBJ_POPUP_LOGIC$(3)
5975 RETURN
6000 ! ^100 - Drop active folder
6010 FLDR_DEACTIVE:
6020 IF _F_EXIT_CMD$="" THEN GOTO 6030 ELSE LET CMD_STR$=_F_EXIT_CMD$,ID=_ID_LS
6020:T+1; GOSUB 7000; IF NEXT_FOLDER<>-1 AND NEXT_FOLDER<>_F_ACTV+11000 THEN LE
6020:T _F_EXIT_CMD$=""
6021 IF IGNORE_EXIT<>0 OR IGNORE_EXIT$="Y" OR NEXT_ID<>-1 OR NEXT_FOLDER<>-1 TH
6021:EN LET IGNORE_EXIT$="",IGNORE_EXIT=0; RESET ; PRECISION _SCR_PRC; PRINT 'C
6021:I',; GOTO NEXT_ID_CHK
6022 LET _F_EXIT_CMD$=""
6030 PRINT _F_IMAGES$,_F_SR$,'DO','CH','CE','SR',; LET _F_SR$=""
6040 LET _F_IMAGES$="",_CUR_IMG$="I_"
6045 IF _FLDR_AUTO_CLOSE OR %NOMAD_AUTO_CLOSE THEN LET _SV_FILES_BEFORE$=_FILES
6045:_BEFORE$,_FILES_BEFORE$=CHN; GOSUB AUTO_CLOSE; LET _FILES_BEFORE$=_SV_FILE
6045:S_BEFORE$
6050 FOR _X=_F_ID_LST+1 TO _ID_LST
6060 IF POS(_TYPE_TBL$[_X]=%NOMADS_CTL_RESET$)<>0 THEN LET _X$=_NAME_TBL$[_X]+"
6060:.ctl"; VIA _X$=0
6070 NEXT
6080 IF _GRPS$<>"" THEN LET _X$=CPL("iolist "+_GRPS$(2)); READ DATA FROM "" TO
6080:IOL=_X$
6090 LET TAB_TABLE$=_FTAB_TABLE$,_ID_LST=_F_ID_LST,_EXT_CNT=_F_EXT_CNT,_GRPS$=_
6090:F_GRPS$,_VAR_LST$=_F_VAR_LST$,_USR_CNT=_F_USR_CNT,_DEF_K$=_F_DEF_K$,_DEF_I
6090:D=_F_DEF_ID,_RBT_TBL$=_F_RBT_TBL$,_DYNAPIC_CNT=_F_DYNAPIC_CNT
6095 LET _F_INIT_IOL$="",_F_INIT_VAL$="",FLDR_DEFAULT_PROG$=""
6100 IF _GRPS$<>"" THEN READ DATA FROM _F_SVGRP$ TO IOL=CPL("iolist "+_GRPS$(2)
6100:)
6110 LET _F_ACTV=0; RETURN
6200 ! ^100 - Setmouse CTL
6210 FLDR_MOUSED:
6220 LET _F_I=CTL-11000,_CUR_ID=_F_ID
6226 LET _XXX=11000+_F_I; IF _XXX'ENABLED=0 THEN GOTO NXT_INP
6230 GOTO FLDR_FOCUS
6300 ! ^100 - Load external control
6310 EXT_INIT:
6320 LET _EXT_CNT=_EXT_CNT+1,ID=12000+_EXT_CNT; CUSTOM_VBX ID,@(_OBJ_C,_OBJ_L,_
6320:OBJ_W,_OBJ_H),_OBJ_IDX$,INIT_TEXT$,TBL=_OBJ_ATTR$,KEY=_OBJ_HOTKEY$,MSG=_OB
6320:J_MSG$
6325 IF _OBJ_TAB<>0 THEN LET TAB_TABLE$=TAB_TABLE$+STR(_OBJ_TAB:"0000")+" "+STR
6325:(ID:"00000")
6330 LET _X_ID$=_OBJ_NME$+".ctl"; VIA _X_ID$=ID
6340 IF _OBJ_SEC$="V" THEN CUSTOM_VBX DISABLE ID
6350 LET _X=POS($00$=_OBJ_DEF$); IF _X=0 THEN RETURN
6360 LET _X$=_OBJ_DEF$(1,_X-1),_OBJ_DEF$=_OBJ_DEF$(_X+1)
6370 LET _X=POS("="=_X$); IF _X=0 THEN GOTO 6350 ELSE LET _X1$=_X$(1,_X-1),_X$=
6370:STP(_X$(_X+1),2)
6380 IF UCS(_X$)="END" THEN GOTO 6400
6390 LET _X=POS(" "=_X$); IF _X=0 THEN GOTO 6350 ELSE LET _X$=_X$(1,1)+_X$(_X+1
6390:)
6400 LET _EXT_CNT=_EXT_CNT+1,_EXT_CMD$[_EXT_CNT]=_X$
6410 CUSTOM_VBX DEFCTL ID,12000+_EXT_CNT,_X1$,ERR=6430
6420 GOTO 6350
6430 MSGBOX "Unable to initialize VBX event "+_X1$,"W A R N I N G","!"; GOTO 63
6430:50
6500 ! ^100 - Refresh screen
6510 REFRESH_SCRN:
6511 LET _I=0
6512 IF _I>=_DYNAPIC_CNT THEN GOTO 6520
6513 LET _X$=EVS(_DYNAPIC_VAR$[_I]); IF _X$<>_DYNAPIC_VAL$[_I] THEN LET _DYNAPI
6513:C_VAL$[_I]=_X$; LET _X$=EVS(_DYNAPIC_CMD$[_I]); PRINT _X$,
6514 _I++; GOTO 6512
6520 LET _I=0
6530 LET _I=_I+1; IF _I>_ID_LST THEN LET REFRESH_FLG=_REFRESH_FLG; RETURN
6540 IF _NAME_TBL$[_I]="" THEN GOTO 6530
6550 LET _T$=_TYPE_TBL$[_I],_X$=_NAME_TBL$[_I]+_SFX$; IF _T$="#" THEN LET _X$=S
6550:TP(_X$,1,"$")
6560 IF NUL(CHG(_X$)) AND REFRESH_FLG<>-1 THEN GOTO 6530 ELSE IF _T$<>"#" THEN
6560:LET _X$=VIS(_X$) ELSE LET _X$=STR(VIN(_X$))
6570 LET _OBJ_OUT$=_OUT_TBL$[_I]; IF _OBJ_OUT$<>"" THEN LET _OBJ_TAG$=EVS(_NAME
6570:_TBL$[_I]+".tag$"); GOSUB OUT_PROC
6575 IF _T$="G" THEN LET _I$=_NAME_TBL$[_I]; IF EVN(_I$+".column")=0 AND EVN(_I
6575:$+".row")=0 THEN GOTO 6530 ELSE GRID WRITE _I+10000,EVN(_I$+".column"),EVN
6575:(_I$+".row"),_X$,ERR=6530; GOTO 6530
6580 IF POS(_T$="LDVXM#")<>0 THEN LIST_BOX WRITE _I+10000,_X$,ERR=6530; IF CTL<
6580:>_I+15000 THEN GOTO 6530 ELSE SET_FOCUS 0; LET _X=_I+10000; LET _X'ONFOCUS
6580:CTL=0; SET_FOCUS _X,ERR=*PROCEED; LET _X'ONFOCUSCTL=_X+5000; GOTO 6530
6590 IF _T$="C" THEN CHECK_BOX WRITE _I+10000,_X$,ERR=6530; GOTO 6530
6600 IF _T$="3" THEN TRISTATE_BOX WRITE _I+10000,_X$,ERR=6530; GOTO 6530
6601 IF _T$<>"R" THEN GOTO 6530
6602 LET _X1=POS(_X$+STR(_I+10000:"00000")=_RBT_TBL$,9)
6603 IF _X1<>0 THEN LET _X$=_RBT_TBL$(_X1+6,3)
6610 RADIO_BUTTON ON _I+10000:NUM(_X$),ERR=6530
6620 GOTO 6530
6700 ! ^100 - Initialize Screen
6710 INIT_SCREEN:
6720 LET _S_INIT=0; IF NOT(NUL(_S_INIT_IOL$)) THEN READ DATA FROM _S_INIT_VAL$
6720:TO IOL=_S_INIT_IOL$; LET _S_INIT=1
6730 INIT_FOLDER_CUR:
6740 LET _F_INIT=0; IF NOT(NUL(_F_INIT_IOL$)) THEN READ DATA FROM _F_INIT_VAL$
6740:TO IOL=_F_INIT_IOL$; LET _F_INIT=1
6750 LET INITIALIZE_FLG=0
6760 RETURN
6800 ! ^100 - Init_folder_all
6801 INIT_ALL:
6802 IF NOT(NUL(_S_INIT_IOL$)) THEN READ DATA FROM _S_INIT_VAL$ TO IOL=_S_INIT_
6802:IOL$
6810 INIT_FOLDER_ALL:
6820 LET INITIALIZE_FLG=0,_X_INIT=0; IF _F_CNT=0 OR _X_INIT_IOL$="*" THEN RETUR
6820:N
6830 IF _X_INIT_IOL$="" THEN CALL "*winproc;Get_x_init",_F_CNT,_F_OBJ${ALL},_X_
6830:INIT_IOL$,_X_INIT_VAL$,_SFX$
6840 IF _X_INIT_IOL$<>"*" THEN READ DATA FROM _X_INIT_VAL$ TO IOL=_X_INIT_IOL$;
6840: LET _X_INIT=1
6850 RETURN
6860 GET_X_INIT: ! - Internal call to avoid variable spoilage
6870 ENTER N,_O${ALL},_I$,_V$,_S$
6880 LET _I$="",_V$=""; FOR _I=1 TO N
6900 READ (%SCR_LIB,KEY=PAD(_O$[_I],12)+"0000",DOM=*NEXT)
6910 IF KEY(%SCR_LIB,END=6960)>PAD(_O$[_I],12)+"9999" THEN GOTO 6960 ELSE READ
6910:(%SCR_LIB)IOL=8010
6920 IF POS(_OBJ_TYPE$="C3LDVXM")=0 OR INIT_VAL$="" THEN GOTO 6910
6930 LET _I$=_I$+","+_OBJ_NME$+_S$,_V$=_V$+INIT_VAL$+SEP
6940 IF _OBJ_TYPE$="M" AND POS("#"=_OBJ_STS$) THEN LET _I$=_I$(1,LEN(_I$)-1)
6950 GOTO 6910
6960 NEXT
6970 IF _I$="" THEN LET _I$="*" ELSE LET _I$=CPL("iolist "+_I$(2))
6980 EXIT
7000 ! 7000 - Process Command
7010 LET NEXT_ID=-1,NEXT_FOLDER=-1,%NOMAD_STK$=""
7015 IF _VALIDATOR_ON THEN IF CMD_STR$="" AND REFRESH_FLG THEN GOSUB REFRESH_SC
7015:RN; RETURN
7020 IF CMD_STR$="" THEN RETURN
7030 IF CMD_STR$="E" OR CMD_STR$="END" THEN EXITTO END_OBJ
7040 IF %DBG_FL THEN PRINT (%DBG_FL)"<Nomads>",_SCREEN_K$,":Process logic Cmd_s
7040:tr$=",CMD_STR$
7050 LET _C$=CMD_STR$,CMD_STR$=""
7060 SET_PARAM 'TU'=_SV_TU
7070 IF _C$(1,1)<>"P" THEN GOTO 7080
7071 LET _C1$=_C$(2)
7072 PERFORM EVS(_C1$),ERR=*NEXT; GOTO 7130
7073 LET _C$="PERFORM "+_C1$; GOTO 7190
7080 IF _C$(1,1)="H" THEN LET _X$=_C$(2); GOSUB DO_HELP; RETURN
7090 IF _C$(1,1)="L" THEN LET _C$="CALL ""*winproc"","+_C$(2); GOTO 7120
7100 IF _C$(1,1)="J" THEN GOSUB JUMP_IT; GOTO 7130
7110 IF _C$(1,1)="C" THEN LET _C$="CALL "+_C$(2) ELSE LET _C$=_C$(2)
7120 PERFORM "*winproc.xeq",ERR=7190
7130 SET_PARAM 'TU'
7140 IF %DBG_FL THEN PRINT (%DBG_FL)"<Nomads>",_SCREEN_K$,":End logic Next_id="
7140:+STR(NEXT_ID)+" Cmd_Str$="""+CMD_STR$+QUO
7145 LET SV_INITIALIZE_FLG=INITIALIZE_FLG
7150 ON INITIALIZE_FLG GOSUB *NEXT,INIT_SCREEN,INIT_FOLDER_ALL,INIT_FOLDER_CUR
7152 IF NOT(SV_INITIALIZE_FLG) THEN EXITTO *NEXT
7155 IF REFRESH_FLG THEN GOSUB REFRESH_SCRN
7160 IF CMD_STR$="" THEN RETURN
7170 IF CMD_STR$="END" OR CMD_STR$="E" THEN EXITTO END_OBJ
7180 GOTO 7030
7190 LET _X$=""
7200 LET _X1$=STR(TCB(12)+(_C$(1,1)<>"P"):"000")
7210 LET _O=POS(SEP=%NOMAD_STK$); IF _O=0 THEN GOTO 7240 ELSE LET _X$=%NOMAD_ST
7210:K$(1,_O-1),%NOMAD_STK$=%NOMAD_STK$(_O+1)
7220 IF _X$(1,3)>_X1$ THEN LET _X$=_X$+SEP+_X$(4,5)+$09$+_X$(9)
7230 GOTO 7210
7240 IF _X$<>"" THEN LET _X$=SEP+SEP+"NOMADS Stack was:"+SEP+SEP+"Stmt#"+$09$+"
7240:Program"+_X$
7250 MSGBOX "Error occuring processing:"+SEP+SEP+$09$+_C$+_X$,MSG(ERR),"!,BEEP"
7260 IF _SV_ERRH$="" THEN ERROR_HANDLER "*winerr" ELSE ERROR_HANDLER _SV_ERRH$
7270 IF CTL>15000 AND CTL<16000 THEN LET QRY_PENDING=0; PRINT 'CI', ! Minimize
7270:set focus loops
7280 GOTO 7130
7300 ! ^100 - Get_id
7310 GET_ID:
7311 GOSUB CHECK_DEF_PRG
7320 LET _X_ID$=_OBJ_NME$+".ctl"
7330 LET _OBJ_IDX=NUM(_OBJ_IDX$,ERR=*NEXT); GOTO 7360
7340 IF _OBJ_IDX$(1,1)="=" THEN LET _OBJ_IDX=EVN(_OBJ_IDX$(2),ERR=7350); GOTO 7
7340:360
7350 LET _OBJ_IDX=VIN(_OBJ_IDX$)
7360 IF _OBJ_TIP$<>"" AND _OBJ_TIP$(1,1)="=" THEN LET _OBJ_TIP$=EVS(_OBJ_TIP$(2
7360:))
7365 IF _OBJ_TYPE$="R" AND VIN(_X_ID$)<>0 THEN LET ID=VIN(_X_ID$); IF _OBJ_SEL$
7365:<>"" THEN GOSUB SEARCH_RBT; GOTO 7490 ELSE GOTO 7490
7370 VIA _X_ID$=_ID_LST; LET _ID_LST=_ID_LST+1; LET ID=_ID_LST+10000
7380 VIA _X_ID$=ID
7390 IF _OBJ_OUT$<>"" AND _OBJ_OUT$(1,1)="=" THEN LET _OBJ_OUT$=EVS(_OBJ_OUT$(2
7390:))
7400 IF _OBJ_INP$<>"" AND _OBJ_INP$(1,1)="=" THEN LET _OBJ_INP$=EVS(_OBJ_INP$(2
7400:))
7410 IF _OBJ_VALID$<>"" AND _OBJ_VALID$(1,1)="=" THEN LET _OBJ_VALID$=EVS(_OBJ_
7410:VALID$(2))
7420 IF _OBJ_TAG$<>"" AND _OBJ_TAG$(1,1)="=" THEN LET _OBJ_TAG$=EVS(_OBJ_TAG$(2
7420:))
7431 IF MID(INIT_VAL$,1,1)="=" THEN LET INIT_VAL$=EVS(INIT_VAL$(2))
7432 IF MID(_OBJ_TBL$,1,1)="=" THEN LET _OBJ_TBL$=EVS(_OBJ_TBL$(2))
7433 IF _OBJ_HOTKEY$="" THEN LET _OBJ_HOTKEY$=EVS(_OBJ_NME$+".hotkey$"); IF _OB
7433:J_HOTKEY$="" THEN LET _OBJ_HOTKEY$=EVS(_OBJ_NME$+".caption$"),_OBJ_HOTKEY$
7433:=MID(_OBJ_HOTKEY$,POS("&"=_OBJ_HOTKEY$)+1,1)
7440 LET _CMD_TBL$[_ID_LST]=_OBJ_SEL$,_TYPE_TBL$[_ID_LST]=_OBJ_TYPE$,_NAME_TBL$
7440:[_ID_LST]=_OBJ_NME$,_HLP_TBL$[_ID_LST]=_OBJ_HLP$,_QRY_TBL$[_ID_LST]=_OBJ_Q
7440:RY$,_INP_TBL$[_ID_LST]=_OBJ_INP$,_OUT_TBL$[_ID_LST]=_OBJ_OUT$,_VLD_TBL$[_I
7440:D_LST]=_OBJ_VALID$
7441 LET _FCS_TBL$[_ID_LST]=""
7445 LET _SV_INIT$=INIT_VAL$
7450 IF _OBJ_TYPE$<>"M" OR POS("#"=_OBJ_STS$)=0 THEN GOTO 7490
7460 LET _TYPE_TBL$[_ID_LST]="#"
7470 LET _X_VAL$=_OBJ_NME$+STP(_SFX$,1,"$"),_X_X$=STR(VIN(_X_VAL$)); IF _X_X$<>
7470:"0" THEN LET INIT_VAL$=_X_X$ ELSE VIA _X_VAL$=NUM(INIT_VAL$,ERR=7500)
7480 GOTO 7500
7490 LET _X_VAL$=_OBJ_NME$+_SFX$,_X_X$=VIS(_X_VAL$); IF _X_X$<>"" THEN LET INIT
7490:_VAL$=_X_X$ ELSE VIA _X_VAL$=INIT_VAL$
7491 IF _OBJ_FONT$="" AND _OBJ_ATTR$="*" THEN LET _OBJ_FONT$=_OBJ_ATTR$,_OBJ_AT
7491:TR$=""
7500 LET _VAR_LST$=_VAR_LST$+","+_X_VAL$
7501 IF _SV_INIT$<>"" AND NOT(NUL(_OBJ_ORIG$)) THEN LET _VAL$=_VAL$+_SV_INIT$+S
7501:EP,_IOL$=_IOL$+","+_X_VAL$
7505 IF POS("K"=_OBJ_STS$)<>0 THEN LET _X$="S" ELSE LET _X$=" "
7510 IF _OBJ_TAB<>0 THEN LET TAB_TABLE$=TAB_TABLE$+STR(_OBJ_TAB:"0000")+_X$+STR
7510:(ID:"00000")
7520 IF _OBJ_TAG$<>"" THEN LET _X_TAG$=_OBJ_NME$+".tag$"; VIA _X_TAG$=_OBJ_TAG$
7530 IF POS("="=_OBJ_MSG$)=1 THEN LET _OBJ_MSG$=EVS(_OBJ_MSG$(2),ERR=7540)
7540 IF _OBJ_GRP$="" THEN RETURN
7550 IF _OBJ_TYPE$="R" THEN LET _X1=_OBJ_IDX|255 ELSE LET _X1=0
7560 LET _G$=BIN(ID,2)+BIN(_X1,1); GOSUB DEF_GRP
7570 RETURN
7580 BAD_IDX: MSGBOX "Invalid index value for "+_OBJ_NAME$+". Value = '"+_OBJ_
7580:IDX$+"'","Panel error","!"; GOTO 7360
7600 ! ^100 - Attr_chk
7610 ATTR_CHK:
7620 IF _OBJ_ATTR$<>"" THEN LET _OBJ_ATTR$=EVS(_OBJ_ATTR$,ERR=7630)
7621 IF _OBJ_FONT$<>"" THEN LET _OBJ_ATTR$=_OBJ_ATTR$+'FONT'(STP(_OBJ_FONT$,3,Q
7621:UO))
7622 IF _OBJ_COLOR$<>"" THEN LET _OBJ_ATTR$=_OBJ_ATTR$+'MODE'(ATH(_OBJ_COLOR$))
7630 RETURN
7640 MSGBOX "Invalid Attribute found:"+SEP+$09$+_OBJ_ATTR$,"Error","!"
7650 RETURN
7700 ! ^100 - Get help stuf
7710 GET_HELP:
7720 LET _H_ID$=_SCR_H_ID$,_H_FL$=_SCR_H_FL$,_X_EXPR=0,_EXTERNAL_HELP=1
7721 IF _X$="'" THEN LET _X$="" ! pointed to default help
7723 IF _X$="" THEN LET _X$=_F_HLP$
7727 IF _X$="" AND MID(_H_ID$+_H_FL$,1,1)="'" THEN LET _EXTERNAL_HELP=0; RETURN
7727:
7728 IF _X$="" THEN LET _EXTERNAL_HELP=_DEFAULT_EXTERNAL_HELP
7730 IF _X$="" THEN RETURN
7735 IF MID(_X$,1,1)="'" THEN LET _X$=_X$(2),_EXTERNAL_HELP=0; GOTO INTERNAL_HE
7735:LP
7740 IF _X$(1,1)=QUO THEN LET _X_EXPR=1,_X$=EVS(_X$,ERR=7770) ELSE IF _X$(1,1)=
7740:"=" THEN LET _X_EXPR=1,_X$=EVS(_X$(2),ERR=7770)
7750 LET _O=POS(";"=_X$); IF _O=0 AND _X_EXPR THEN LET _H_FL$=_X$,_H_ID$=""; RE
7750:TURN
7755 IF _O<>0 THEN LET _H_FL$=_X$(1,_O-1),_X$=_X$(_O+1)
7760 LET _H_ID$=_X$; RETURN
7770 MSGBOX "Invalid help specification:"+SEP+_X$,"Help Subsystem","!"; RETURN
7780 INTERNAL_HELP:
7785 LET _H_ID$="",_H_FL$=_X$
7788 IF _H_FL$="" THEN IF NOT(_DEFAULT_EXTERNAL_HELP) THEN LET _H_FL$=_SCR_H_FL
7788:$
7795 IF _H_FL$<>"" THEN IF _H_FL$(1,1)=QUO THEN LET _H_FL$=EVS(_H_FL$,ERR=7770)
7795: ELSE IF _H_FL$(1,1)="=" THEN LET _H_FL$=EVS(_H_FL$(2),ERR=7770)
7796 RETURN
7800 ! ^100 - Do Load Logic
7810 LOAD_LOGIC: LET CMD_STR$=_OBJ_DSP$; GOSUB 7000
7820 IF INIT_VAL$<>"" THEN VIA _X_VAL$=INIT_VAL$
7830 RETURN
7900 ! 7900 - Search tables for matching control name (if match found load tabl
7900:es with the current radiobutton info)
7910 SEARCH_RBT:
Volver arriba
invitado-2
Invitado





MensajePublicado: Mie 24 May 2006 12:07:20    Asunto: Responder citando

Lo ha cortado en el envio.
Resto del programa desde linea 7910

7910 SEARCH_RBT:
7920 LOCAL _X
7930 FOR _X=1 TO _ID_LST
7940 IF _NAME_TBL$[_ID_LST]=_OBJ_NME$ AND _TYPE_TBL$[_ID_LST]="R" THEN LET _CMD
7940:_TBL$[_ID_LST]=_OBJ_SEL$,_TYPE_TBL$[_ID_LST]=_OBJ_TYPE$,_NAME_TBL$[_ID_LST
7940:]=_OBJ_NME$,_HLP_TBL$[_ID_LST]=_OBJ_HLP$,_QRY_TBL$[_ID_LST]=_OBJ_QRY$,_INP
7940:_TBL$[_ID_LST]=_OBJ_INP$,_OUT_TBL$[_ID_LST]=_OBJ_OUT$,_VLD_TBL$[_ID_LST]=_
7940:OBJ_VALID$,_FCS_TBL$[_ID_LST]=""; BREAK
7950 NEXT
7960 RETURN
8000 ! 8000 - IOLIST
8010 IOLIST _OBJ_NME$,_OBJ_C,_OBJ_L,_OBJ_W,_OBJ_H,_OBJ_TYPE$,INIT_TEXT$,INIT_VA
8010:L$,_OBJ_TAB,_OBJ_DEF$,_OBJ_DSP$,_OBJ_FCS$,_OBJ_SEL$,_OBJ_MSG$,_OBJ_HLP$,_O
8010:BJ_ATTR$,_OBJ_IDX$,_OBJ_HOTKEY$,_OBJ_QRY$,_OBJ_SEC$,_OBJ_STS$,_OBJ_GRP$,_O
8010:BJ_NULL$,_OBJ_TAG$,_OBJ_TBL$,_OBJ_INP$,_OBJ_OUT$,_OBJ_VALID$,_OBJ_CLASS$,_
8010:OBJ_TIP$,_OBJ_ORIG$,_OBJ_FONT$,_OBJ_COLOR$,_OBJ_LISTBOX_TYPE$,_OBJ_SEP$,_O
8010:BJ_SCRATCH$,_OBJ_POPUP$,_OBJ_SIZING$,_OBJ_LOGIC1$,_OBJ_LOGIC2$,_OBJ_POPUP_
8010:LOGIC$
8100 ! ^100 - Add _g$ to group
8110 DEF_GRP:
8120 LET _XG$=STP(_OBJ_GRP$,2,",")+","
8130 LET _X=POS(","=_XG$); IF _X=0 THEN RETURN ELSE LET _X$=UCS(STP(_XG$(1,_X-1
8130:),3))+".grp$",_XG$=_XG$(_X+1)
8140 LET _X1$=VIS(_X$)
8150 IF _X1$="" THEN LET _X1$="000",_X1=0,_GRPS$=_GRPS$+","+_X$ ELSE LET _X1=NU
8150:M(_X1$(1,3))
8160 IF LEN(_G$)=3 THEN LET _X1$=STR(_X1+1:"000")+_X1$(4,_X1*6)+HTA(_G$)+_X1$(_
8160:X1*6+4) ELSE IF POS(_G$=_X1$(4),6)=0 THEN LET _X1$=_X1$+_G$
8170 VIA _X$=_X1$; GOTO 8130
8200 ! ^100 - Get Focus info
8210 FOCUS_SETUP:
8230 LET _FCS_TBL$[ID-10000]=_OBJ_FCS$
8240 RETURN
8300 ! ^100 - Get Popup Menu info
8310 POPUP_SETUP:
8320 LET MNU_ID=0; IF _OBJ_POPUP$="" THEN RETURN
8325 IF STP(_OBJ_POPUP_LOGIC$,2)<>"" THEN GOSUB CHECK_DEF_PRG
8330 LET MNU_ID=ID+8000
8340 LET _POPUP_TBL$[ID-10000]=_OBJ_POPUP$,_POPUP_LOGIC_TBL$[ID-10000]=_OBJ_POP
8340:UP_LOGIC$
8350 RETURN
8500 ! 8500 - Notes on CMDs
8510 ! Normally CMD is simply executed with the following exceptions
8520 ! "END" Terminate form
8530 ! (Note: After CMD is executed the value of CMD_STR$ will be next comand)
8800 ! 8800 - No such form
8805 LET _X$=SCRN_K$,_X$(1,1)=IOR(_X$(1,1),$80$); READ (%SCR_LIB,KEY=_X$+"0000"
8805:,DOM=8810)IOL=8010
8807 LET SCRN_K$=_X$; GOTO USE_WORK_VER
8810 MSGBOX "Unable to locate screen '"+SCRN_ID$+"'"+SEP+SEP+"Library:"+SEP+PTH
8810:(%SCR_LIB)+SEP+SEP+"Current Dir:"+LWD+SEP+"Prefix:"+PFX,"Screen Manager","
8810:!,BEEP"
8820 GOTO 9000
8900 ! 8900 - Screen library missing
8910 MSGBOX "Unable to locate screen library. Cannot process request for scree
8910:n "+SCRN_ID$+SEP+SEP+"Current Dir:"+LWD+SEP+"Prefix:"+PFX,"Screen Manager"
8910:,"!,BEEP"
8920 STOP
9000 ! 9000 - Close window
9010 WRAPUP:
9020 IF %DBG_FL THEN PRINT (%DBG_FL)"<Nomads>",_SCREEN_K$,":End screen"
9025 IF %NOMAD_PANEL_INFO_PROG$<>"" THEN GOSUB SAVE_PANEL_INFO
9030 SET_PARAM 'WI'=_SV_WI,'TU'=_SV_TU,'EX'=_SV_EX
9040 IF _WDW THEN PRINT 'POP',
9041 IF %NOMAD_SCRIPT_WDW<>0 THEN PRINT 'GOTO'(%NOMAD_SCRIPT_WDW),'SWAP',
9042 IF _AUTO_CLOSE OR %NOMAD_AUTO_CLOSE THEN GOSUB AUTO_CLOSE
9044 LET _TTT=1
9045 LET _TTT$=STR(_NAME_TBL$[_TTT]+".CTL",ERR=*NEXT),_TTT=_TTT+1; VIA _TTT$=0,
9045:ERR=*SAME; GOTO *SAME
9046 PRINT 'IMAGE'(DELETE "*winproc*"),
9047 IF _GRPS$<>"" THEN LET _X$=CPL("iolist "+_GRPS$(2)); READ DATA FROM "" TO
9047:IOL=_X$
9050 IF _SV_DIR$<>$00$ THEN CWDIR _SV_DIR$,ERR=9060
9060 IF _SV_PFX$<>$00$ THEN PREFIX _SV_PFX$
9070 IF _SCR_MSG$<>$00$ THEN MESSAGE_LIB _SCR_MSG$
9080 IF _SCR_ATTR$<>$00$ THEN LET %SCR_DEF_ATTR$=_SCR_ATTR$
9090 IF _SCR_H_ID$<>$00$ THEN LET %SCR_DEF_H_ID$=_SCR_H_ID$,%SCR_DEF_H_FL$=_SCR
9090:_H_FL$
9100 IF _SCR_3D<>-1 THEN LET %SCR_3D=_SCR_3D
9110 IF _SCR_LIB<>-1 THEN CLOSE (%SCR_LIB); LET %SCR_LIB=_SCR_LIB
9120 ERROR_HANDLER _SV_ERRH$
9122 IF REPLACEMENT_SCRN$="" THEN GOTO 9128
9123 LET SCRN_ID$=REPLACEMENT_SCRN$
9124 IF REPLACEMENT_LIB$<>"" THEN LET SCRN_LIB$=REPLACEMENT_LIB$
9125 LET REPLACEMENT_LIB$="",REPLACEMENT_SCRN$=""
9126 GOTO POST_ENTER
9128 IF %NOMADS_ONEXIT$<>"" THEN RUN %NOMADS_ONEXIT$
9130 END
9200 ! ^ 100 - Error handler
9210 SYS_ERR:
9211 PRECISION _SCR_PRC
9220 MSGBOX MSG(ERR)+SEP+SEP+"An error has occured while processing the screen
9220:"+SCRN_ID$+" in "+PTH(%SCR_LIB)+SEP+"["+STR(TCB(5))+"]","Panel processing
9220:Error","!"; GOTO 9000
9500 ! ^100 - Close files
9510 AUTO_CLOSE:
9520 LET _FILES_AFTER$=CHN
9530 IF _FILES_AFTER$="" THEN RETURN
9535 LET _XF=PRM('XF'); IF _XF=0 THEN LET START_GFN=64 ELSE LET START_GFN=32768
9540 IF POS(_FILES_AFTER$(1,2)=_FILES_BEFORE$,2)=0 THEN LET _XXX=DEC($00$+_FILE
9540:S_AFTER$(1,2)); IF _XXX<START_GFN THEN CLOSE (_XXX,ERR=*NEXT)
9550 LET _FILES_AFTER$=_FILES_AFTER$(3); GOTO 9530
10000 ! 10000 - Save all data and jump to screen
10010 JUMP_IT:
10020 LOCAL REPLACEMENT_SCRN$,REPLACEMENT_LIB$
10030 LET REPLACEMENT_SCRN$=STP(STP(_C$(2),1),3,QUO)
10040 LET _I=POS(","=REPLACEMENT_SCRN$); IF _I=0 THEN LET REPLACEMENT_LIB$="" E
10040:LSE LET REPLACEMENT_LIB$=REPLACEMENT_SCRN$(_I+1),REPLACEMENT_SCRN$=REPLAC
10040:EMENT_SCRN$(1,_I-1)
10045 LET REPLACEMENT_SCRN$=UCS(REPLACEMENT_SCRN$)
10050 PERFORM PGN+";overlay_screen"
10060 LET REFRESH_FLG=-1; RETURN
10070 ! Save all values, ctl#s, and tags
10080 OVERLAY_SCREEN:
10090 IF _ID_LST=0 THEN GOTO 10160
10100 LET _I=0
10110 LET _I=_I+1
10120 IF _I>_ID_LST THEN GOTO 10160
10130 LET _X1$=_NAME_TBL$[_I]
10140 IF NOT(NUL(_X1$)) THEN EXECUTE "LOCAL "+_X1$+".ctl,"+_X1$+".tag$"
10150 GOTO 10110
10160 IF _F_CNT=0 THEN GOTO 10220
10170 LET _I=0
10180 LET _I=_I+1
10190 IF _I>_F_CNT THEN GOTO 10220
10200 EXECUTE "LOCAL fldr."+STP(_F_OBJ$[_I],1)+".ctl"
10210 GOTO 10180
10220 ! Save Groups
10230 EXECUTE "LOCAL _grps$,_f_grps$"+_GRPS$+_F_GRPS$
10240 ! Save Panel control info
10250 LOCAL SCRN_ID$,SCRN_LIB$,EXIT_CMD$,DISP_CMD$,TAB_TABLE$,DEFAULT_PROG$,MAI
10250:N_SCRN_K$,IGNORE_EXIT,IGNORE_EXIT$,NEXT_ID,NO_FLUSH,CMD_STR$,INITIALIZE_F
10250:LG,_DYNAPIC_CNT
10255 IF NOT(POS("DLG_LINK_"=UCS(REPLACEMENT_SCRN$))) THEN LOCAL CHANGE_FLG
10260 LOCAL _SV_WI,_SV_3D,_SV_TU,_SV_EX,_WDW,_SV_DIR$,_SV_PFX$,_SCR_MSG$,_SCR_A
10260:TTR$,_SCR_H_ID$,_SCR_3D,_SCR_LIB,_SV_ERRH$,_SCR_PRC
10270 LOCAL _CUR_IMG$,ID$,ID,_DEF_K$,_ID_LST,_EXT_CNT,_USR_CNT,_RBT_TBL$,QRY_PE
10270:NDING,_SFX$
10280 ! Save Field/CTL Definition arrays
10290 LOCAL DIM _CMD_TBL$[0],_TYPE_TBL$[0],_NAME_TBL$[0],_HLP_TBL$[0],_QRY_TBL$
10290:[0],_FCS_TBL$[0],_INP_TBL$[0],_OUT_TBL$[0],_VLD_TBL$[0],_EXT_CMD$[0],_USR
10290:_CMD$[0],_USR_CTL[0],_DYNAPIC_VAL$[0],_DYNAPIC_CMD$[0],_DYNAPIC_VAR$[0],_
10290:POPUP_TBL$[0],_DRAGON_CMD$[0],_DRAGON_CTL[0],_DRAGON_FR_CTL$[0],_DRAGON_T
10290:O_CTL$[0]
10300 ! Save Folder stuff
10310 LOCAL DIM _F_TXT$[0],_F_OBJ$[0]
10320 LOCAL FOLDER_ID$,NEXT_FOLDER,_F_ACTV,_F_CNT,_F_FCS,_F_ID,_F,_F_T,_F_B,_F_
10320:X,_F_W,_F_CLR,_FTAB_TABLE$,_F_VAR_LST$,_F_ID_LST,_F_EXT_CNT,_F_USR_CNT,_F
10320:_LN,_F_COL,_F_WD,_F_HI,_F_EXIT_CMD$,_F_DISP_CMD$,_F_IMAGES$,_F_GRPS$,_F_S
10320:R$,_F_SVGRP$,_F_DEF_K$,_F_DEF_ID,_F_CLRTBL$,_FLDR_COLOR$,_F_RBT_TBL$,FLDR
10320:_DEFAULT_PROG$,_F_DYNAPIC_CNT,_F_HLP$
10330 ! Set new form
10340 LET SCRN_ID$=REPLACEMENT_SCRN$,SCRN_LIB$=REPLACEMENT_LIB$
10350 LET REPLACEMENT_SCRN$="",REPLACEMENT_LIB$=""
10360 GOTO POST_ENTER
11000 ! ^1000 - Trace logic
11010 TRACE_INFO:
11011 IF %NOMADS_TRACE_FILE$="" THEN IF POS("WINDOWS"=SYS) THEN LET %NOMADS_TRA
11011:CE_FILE$="c:\nomads.trc" ELSE LET %NOMADS_TRACE_FILE$="/tmp/"+WHO+".trace
11011:"
11020 IF %DBG_FL=0 THEN GOTO 11070
11030 ENDTRACE
11040 CLOSE (%DBG_FL)
11050 LET %DBG_FL=0
11060 IF POS("WINDOWS"=SYS) AND TCB(8Cool=0 THEN INVOKE WAIT "notepad "+%NOMADS_T
11060:RACE_FILE$ ELSE MSGBOX "The trace file '"+%NOMADS_TRACE_FILE$+"' has been
11060: created.","F.Y.I.","INFO"
11070 MSGBOX "Start Nomads trace?","Trace request sensed","?,YESNO",_T$
11080 IF _T$<>"YES" THEN GOTO NXT_INP
11090 SERIAL %NOMADS_TRACE_FILE$,ERR=*NEXT; GOTO 11120
11100 MSGBOX "Erase existing trace file?","About to start trace","?,YESNO",_T$
11110 IF _T$="YES" THEN ERASE %NOMADS_TRACE_FILE$; GOTO 11090
11120 LET _X=GFN; OPEN LOCK (_X)%NOMADS_TRACE_FILE$
11130 LET %DBG_FL=_X
11140 SETTRACE (%DBG_FL)
11150 LET _X$=MSE; LET _X=DEC(_X$(20,2)); SET_FOCUS _X,ERR=11160; WAIT .2; PRIN
11150:T 'CI',
11160 GOTO NXT_INP
12000 ! ^1000 - Non-Nomads screen
12010 NON_NOMADS:
12020 LET _SV_WK=PRM('WK')
12030 SET_PARAM 'WK'
12040 LET _C$=CMD_STR$(2); IF _C$<>"" AND _C$(1,1)="=" THEN LET _C$=EVS(_C$(2))
12050 CALL _C$,ERR=12080
12060 GOTO WRAPUP
12070 PRINT 'POP',; GOTO WRAPUP
12080 MSGBOX "Error occured in Non-nomads program:"+_C$+SEP+"Statement number:"
12080:+STR(TCB(30):"#0000"),MSG(ERR),"!"
12090 GOTO 12060
13000 ! ^1000 - Down arrow
13010 DWN_ARROW:
13020 SET_FOCUS READ _X; LET ID=_X-10000
13030 READ (%SCR_LIB,KEY=SCRN_K$+"0000")
13040 LET _X$=KEY(%SCR_LIB,END=13090); IF _X$(1,12)<>SCRN_K$ THEN GOTO 13090
13050 READ (%SCR_LIB)IOL=8010
14000 ! ^1000 - Make window centered
14010 CENTER_WDW:
14020 GOSUB GET_XYINFO
14030 LET _OBJ_C=INT((%NOMAD_XMAX/%NOMAD_XCHAR-_OBJ_W)/2)
14040 LET _OBJ_L=INT((%NOMAD_YMAX/%NOMAD_YCHAR-_OBJ_H)/2)
14050 RETURN
14100 ! ^100 - Make window relative
14110 RELATIVE_WDW:
14120 GOSUB GET_XYINFO
14130 LET _X$=OBJ(0)
14131 IF %NOMAD_RELATIVE_WDW>0 THEN LET _OBJ_C=%NOMAD_RELATIVE_WDW,_OBJ_L=%NOMA
14131:D_RELATIVE_WDW
14132 LET _MAX_C=%NOMAD_XMAX/%NOMAD_XCHAR
14133 LET _MAX_L=%NOMAD_YMAX/%NOMAD_YCHAR
14140 LET _OBJ_C=_OBJ_C+INT(MAX(0,DEC(_X$(21,2)))/%NOMAD_XCHAR)
14150 LET _OBJ_L=_OBJ_L+INT(MAX(0,DEC(_X$(23,2)))/%NOMAD_YCHAR)
14151 IF _OBJ_C<0 OR _OBJ_C+10>_MAX_C THEN GOTO CENTER_WDW
14152 IF _OBJ_L<0 OR _OBJ_L+3>_MAX_L THEN GOTO CENTER_WDW
14160 RETURN
14200 ! ^100 - Get xChar/yChar/xMax/yMax
14210 GET_XYINFO:
14220 IF %NOMAD_XCHAR<>0 THEN RETURN
14230 LET _X$=MSE
14240 LET %NOMAD_XCHAR=DEC($00$+_X$(10,1))
14250 LET %NOMAD_YCHAR=DEC($00$+_X$(11,1))
14260 LET %NOMAD_XMAX=DEC(_X$(27,2))
14270 LET %NOMAD_YMAX=DEC(_X$(29,2))
14271 LET %NOMAD_WIN_VER=TCB(25)
14272 IF _X$(22,1)<>$FF$ AND _X$(22,1)>$04$ THEN LET _X=25; CALL "[wdx]*windx.u
14272:tl;GET_TCB",ERR=*NEXT,_X; LET %NOMAD_WIN_VER=_X
14280 RETURN
15000 ! ^1000 - Check for test versions
15100 CHECK_TEST:
15110 IF %NOMADS_NOTEST THEN RETURN
15120 LET _X$=SCRN_K$,_X$(1,1)=IOR(_X$(1,1),$80$)
15121 READ (%SCR_LIB,KEY=_X$+"0000",DOM=TEST_REPOS)IOL=8010
15131 LET SCRN_K$=_X$; RETURN
15132 TEST_REPOS:
15133 READ (%SCR_LIB,KEY=SCRN_K$+"0000",DOM=*NEXT)
15134 RETURN
16000 ! ^1000 - Macro process
16010 DO_SCRIPT:
16011 LOCAL _O
16012 SET_PARAM '!I' ! Mark Input queued
16020 READ RECORD (%NOMAD_SCRIPT_FN,END=END_SCRIPT_GOSUB)_X$
16025 LET _O=NUM(_X$,ERR=*NEXT); PREINPUT NEXT _O; RETURN
16026 IF UCS(_X$)="*END" THEN PREINPUT NEXT -1999; RETURN
16030 LET _O=POS("="=_X$); IF _O=0 THEN LET _X1$="" ELSE LET _X1$=_X$(_O+1),_X$
16030:=_X$(1,_O-1)
16031 LET _X$=UCS(_X$)
16032 IF _X$="*EXECUTE" THEN LET _X$="X"+_X1$; GOSUB 7000; RETURN
16033 IF _X$="*FOLDER" THEN PREINPUT NEXT EVN("fldr."+_X1$+".ctl"); RETURN
16034 IF _X$="*MSGBOX" THEN GOSUB END_SCRIPT_GOSUB; MSGBOX "Syncronization erro
16034:r has occured during macro playback","Playback error","!"; RETURN
16040 FOR _O=1 TO _ID_LST
16050 IF _X$=_NAME_TBL$[_O] THEN EXITTO 16080
16060 NEXT
16070 GOSUB END_SCRIPT_GOSUB; MSGBOX "Unrecognized control name:"+SEP+SEP+$09$+
16070:_X$+SEP+SEP+"Aborting script playback","Playback error","!"; RETURN
16080 IF POS(_TYPE_TBL$[_O]="LDVXM#")<>0 THEN MULTI_LINE WRITE _O+10000,_X1$,ER
16080:R=*NEXT
16081 IF _TYPE_TBL$[_O]="C" THEN CHECK_BOX WRITE _O+10000,_X1$,ERR=*NEXT
16082 IF _TYPE_TBL$[_O]="3" THEN TRISTATE_BOX WRITE _O+10000,_X1$,ERR=*NEXT
16083 IF _TYPE_TBL$[_O]="R" THEN RADIO_BUTTON ON _O+10000:NUM(_X1$),ERR=*NEXT
16090 PREINPUT NEXT _O+10000
16100 RETURN
16101 END_SCRIPT: GOSUB END_SCRIPT_GOSUB; EXIT
16110 END_SCRIPT_GOSUB:
16120 IF %NOMAD_SCRIPT_FN<>0 THEN CLOSE (%NOMAD_SCRIPT_FN)
16121 IF %NOMAD_SCRIPT_LOG<>0 THEN CLOSE (%NOMAD_SCRIPT_LOG); PRINT 'DROP'(%NOM
16121:AD_SCRIPT_WDW),
16130 LET %NOMAD_SCRIPT_FN=0,%NOMAD_SCRIPT_LOG=0,%NOMAD_SCRIPT_WDW=0; SET_PARAM
16130: -'!I'
16140 RETURN
16200 ! ^100 - Initiate script
16210 START_SCRIPT: GOSUB END_SCRIPT_GOSUB
16220 ENTER X$,ERR=*NEXT ! Get script file name
16230 IF X$="" THEN GET_FILE_BOX READ X$,"","Select script file for playback","
16230:Nomad Script (*.NMS)|*.NMS/All Files (*.*)|*.*/","nms"; IF X$="" THEN EXI
16230:T
16240 LET X=GFN; OPEN (X,ERR=BAD_SCRIPT)X$
16250 LET %NOMAD_SCRIPT_FN=X; SET_PARAM '-I'; EXIT
16260 BAD_SCRIPT: MSGBOX "Unable to open Nomads script file:"+SEP+SEP+X$,MSG(RE
16260:T),"!"; EXIT
16500 ! ^500 - Start Recorder
16510 MAKE_SCRIPT: GOSUB END_SCRIPT_GOSUB
16520 ENTER X$,ERR=*NEXT
16530 IF X$="" THEN GET_FILE_BOX WRITE X$,"","Script file to record","Nomad Scr
16530:ipt (*.NMS)|*.NMS/All Files (*.*)|*.*/","nms"; IF X$="" THEN EXIT
16531 SERIAL X$,ERR=*NEXT
16540 LET X=GFN; OPEN PURGE (X,ERR=BAD_SCRIPT)X$; LET %NOMAD_SCRIPT_LOG=X
16541 GOSUB GET_XYINFO
16542 LET _X=INT(%NOMAD_XMAX/%NOMAD_XCHAR)
16560 LET %NOMAD_SCRIPT_WDW=HWN(0); PRINT 'DIALOGUE'(_X-20,0,20,3,HWN(0),"Nomad
16560:s Script",OPT="^"),'B?','SR','CS',
16561 BUTTON *-1980,@(1,.5,18,2)="{!Stop}End Recording",FNT="MS Sans Serif"
16562 PRINT 'SWAP',
16563 SET_PARAM '!I'
17000 EXIT
20000 ! ^100 - Filter list box attributes
20010 FILTER_ATTRIBUTES:
20020 LET _LST_ATTR$=_OBJ_STS$; IF _LST_ATTR$="" THEN RETURN
20030 IF _OBJ_LISTBOX_TYPE$="S" THEN LET _STP_CHRS$="rlepq|b!V"; GOSUB DO_ATTR_
20030:STRIP
20040 IF _OBJ_LISTBOX_TYPE$="F" THEN LET _STP_CHRS$="rlepq|b!V"; GOSUB DO_ATTR_
20040:STRIP
20060 IF _OBJ_LISTBOX_TYPE$="e" THEN LET _STP_CHRS$="#lrp~V"; GOSUB DO_ATTR_STR
20060:IP
20065 IF _OBJ_LISTBOX_TYPE$="L" THEN LET _STP_CHRS$="~|!"; GOSUB DO_ATTR_STRIP
20070 RETURN
22000 ! ^100 - Strip list box attributes
22010 DO_ATTR_STRIP:
22020 LET _P=POS(_STP_CHRS$:_LST_ATTR$); IF _P<>0 THEN LET _LST_ATTR$=_LST_ATTR
22020:$(1,_P-1)+_LST_ATTR$(_P+1); GOTO *SAME
22030 RETURN
24000 ! ^100 - Parse fmt listbox definition (evaluate title and width)
24010 PARSE_FMT_LBX:
24015 IF _OBJ_LISTBOX_TYPE$="e" OR _OBJ_LISTBOX_TYPE$="S" THEN RETURN
24020 IF _FMT_LBX$="" OR POS("="=_FMT_LBX$)=0 THEN RETURN
24030 LET _TEMP_FMT$=_FMT_LBX$,_NEW_FMT_LBX$=""
24040 LET _X1=POS(","+$09$:_TEMP_FMT$)
24045 LET _FMT_TITLE$="",_FMT_WIDTH$="",_CELLTYPE$=""
24050 IF _X1=0 THEN LET _FMT_LBX$=_NEW_FMT_LBX$; RETURN
24060 LET _X1$=_TEMP_FMT$(1,_X1-1),_TEMP_FMT$=_TEMP_FMT$(_X1+1)
24070 IF _X1=1 THEN GOTO BUILD_NEW_FMT
24090 IF _X1$(1,1)<>"[" THEN GOTO 24120
24100 LET _X2=POS("]"=_X1$); IF _X2<>0 THEN LET _FMT_TITLE$=_X1$(2,_X2-2),_X1$=
24100:_X1$(_X2+1)
24110 IF POS("="=_FMT_TITLE$)=1 THEN LET _FMT_TITLE$=EVS(_FMT_TITLE$(2),ERR=*NE
24110:XT)
24115 LET _FMT_TITLE$="["+_FMT_TITLE$+"]"
24120 IF _OBJ_TYPE$="G" THEN LET _Q=POS(")"=_X1$); IF _Q<>0 THEN LET _CELLTYPE$
24120:=_X1$(1,_Q),_X1$=_X1$(_Q+1)
24123 LET _FMT_WIDTH$=_X1$
24125 IF POS("="=_X1$)=2 THEN LET _FMT_WIDTH=EVN(_X1$(3),ERR=BUILD_NEW_FMT) ELS
24125:E GOTO BUILD_NEW_FMT
24127 LET _FMT_WIDTH=MAX(_FMT_WIDTH,1),_FMT_WIDTH$=_X1$(1,1)+STR(_FMT_WIDTH)
24130 BUILD_NEW_FMT:
24140 LET _NEW_FMT_LBX$=_NEW_FMT_LBX$+_FMT_TITLE$+_CELLTYPE$+_FMT_WIDTH$+","
24150 GOTO 24040
25000 ! ^100 - Set colour
25010 SET_COLOURS:
25030 IF _OBJ_COLOR$="" THEN RETURN
25040 LET _FCLR$="DEFAULT",_BCLR$="DEFAULT",_FCLR_VAL=-1,_BCLR_VAL=-1
25045 GOSUB CUSTOM_COLORS
25050 IF POS("RGB:"=_FCLR$)=0 THEN LET _FCLR_VAL=DEC(ATH(_F$))
25060 IF POS("RGB:"=_BCLR$)=0 THEN LET _BCLR_VAL=DEC(ATH(_B$))
25070 IF _FCLR_VAL>=0 THEN LET _FCLR$=TBL(_FCLR_VAL,"BLACK","LIGHT RED","LIGHT
25070:GREEN","LIGHT YELLOW","LIGHT BLUE","LIGHT MAGENTA","LIGHT CYAN","WHITE","
25070:DARK GRAY","DARK RED","DARK GREEN","DARK YELLOW","DARK BLUE","DARK MAGENT
25070:A","DARK CYAN","LIGHT GRAY")
25080 IF _BCLR_VAL>=0 THEN LET _BCLR$=TBL(_BCLR_VAL,"BLACK","DARK RED","DARK GR
25080:EEN","DARK YELLOW","DARK BLUE","DARK MAGENTA","DARK CYAN","WHITE","DARK G
25080:RAY","LIGHT RED","LIGHT GREEN","LIGHT YELLOW","LIGHT BLUE","LIGHT MAGENTA
25080:","LIGHT CYAN","LIGHT GRAY")
25090 IF ID'CTLNAME$="RADIO_BUTTON" THEN LET ID'ID=NUM(_OBJ_IDX$,ERR=*NEXT)
25110 IF _FCLR$<>"" THEN LET ID'TEXTCOLOUR$=_FCLR$
25120 IF _BCLR$<>"" THEN LET ID'BACKCOLOUR$=_BCLR$
25130 RETURN
26000 ! ^100 - Custom Colours
26010 CUSTOM_COLORS:
26020 LET _P=POS(";"=_OBJ_COLOR$)
26030 IF _P=0 THEN LET _F$=_OBJ_COLOR$(1,2),_B$=_OBJ_COLOR$(3,2); RETURN
26040 LET _F$=_OBJ_COLOR$(1,_P-1),_B$=_OBJ_COLOR$(_P+1)
26050 IF POS("RGB:"=_F$) THEN LET _FCLR$=_F$
26060 IF POS("RGB:"=_B$) THEN LET _BCLR$=_B$
26070 RETURN
27000 ! ^100 - Grid
27010 DISP_GRID:
27013 GOSUB POPUP_SETUP
27015 LET _FMT_LBX$=_OBJ_NULL$
27020 IF _OBJ_SEP$<>"" AND POS("$"=_OBJ_SEP$) AND LEN(_OBJ_SEP$)>1 THEN LET _OB
27020:J_SEP$=ATH(_OBJ_SEP$,ERR=*NEXT); GOTO 27035
27030 IF _OBJ_SEP$<>"" AND LEN(_OBJ_SEP$)>1 THEN LET _OBJ_SEP$=EVS(_OBJ_SEP$,ER
27030:R=*NEXT)
27035 GOSUB PARSE_FMT_LBX
27037 TRANSLATE _FMT_LBX$," ",","
27040 GRID ID,@(_OBJ_C,_OBJ_L,_OBJ_W,_OBJ_H),FNT=_OBJ_FONT$,MSG=_OBJ_MSG$,KEY=_
27040:OBJ_HOTKEY$,OPT=_OBJ_STS$,TIP=_OBJ_TIP$,FMT=_FMT_LBX$,SEP=PAD(_OBJ_SEP$,1
27040:,SEP),MNU=MNU_ID
27045 IF INIT_TEXT$<>"" THEN LET ID'ROW=0,ID'COLUMN=0,ID'CELLTYPE$=INIT_TEXT$
27047 IF LEN(_OBJ_DEF$)=2 THEN LET ID'RESIZABLE$=_OBJ_DEF$(1,1),ID'EXCELSTYLE$=
27047:_OBJ_DEF$(2)
27050 IF _OBJ_IDX$<>"" THEN LET ID'LOCKCOLUMNS$=_OBJ_IDX$
27055 GOSUB SET_COLOURS
27060 IF _OBJ_DSP$<>"" THEN GOSUB LOAD_LOGIC
27070 IF _OBJ_FCS$<>"" THEN GOSUB FOCUS_SETUP; GRID SET_FOCUS ID,ID+5000
27080 RETURN
29000 ! ^100 - Chart
29010 DISP_CHART:
29013 GOSUB POPUP_SETUP
29015 IF _OBJ_SEP$<>"" AND POS("$"=_OBJ_SEP$) AND LEN(_OBJ_SEP$)>1 THEN LET _OB
29015:J_SEP$=ATH(_OBJ_SEP$,ERR=*NEXT); GOTO 29020
29017 IF _OBJ_SEP$<>"" AND LEN(_OBJ_SEP$)>1 THEN LET _OBJ_SEP$=EVS(_OBJ_SEP$,ER
29017:R=*NEXT)
29020 CHART ID,@(_OBJ_C,_OBJ_L,_OBJ_W,_OBJ_H),FNT=_OBJ_FONT$,OPT=_OBJ_STS$,TIP=
29020:_OBJ_TIP$,FMT=_OBJ_NULL$,SEP=PAD(_OBJ_SEP$,1,SEP),MNU=MNU_ID
29030 GOSUB SET_COLOURS
29040 IF _OBJ_DSP$<>"" THEN GOSUB LOAD_LOGIC
29050 RETURN
30000 ! ^100 - Arc
30010 DISP_ARC:
30020 GOSUB SHAPES_INFO
30030 PRINT _I1$,_OBJ_ATTR$,'PEN'(NUM(PEN_STYLE$),PEN_WIDTH,NUM(PEN_COLOUR$)),'
30030:ARC'(@X(_OBJ_C),@Y(_OBJ_L),@X(RADIUS*_ADJ_W)-_AT_X0,RATIO,START_ANGLE,END
30030:_ANGLE),'RM',_I2$,
30040 RETURN
31000 ! ^100 - Circle
31010 DISP_CIRCLE:
31020 GOSUB SHAPES_INFO
31030 PRINT _I1$,_OBJ_ATTR$,'PEN'(NUM(PEN_STYLE$),PEN_WIDTH,NUM(PEN_COLOUR$)),'
31030:FILL'(NUM(FILL_PATTERN$),NUM(FILL_COLOUR$)),'CIRCLE'(@X(_OBJ_C),@Y(_OBJ_L
31030:),@X(RADIUS*_ADJ_W)-_AT_X0,RATIO),'RM',_I2$,
31040 RETURN
32000 ! ^100 - Line
32010 DISP_LINE:
32015 IF _OBJ_NULL$="" THEN RETURN
32020 GOSUB SHAPES_INFO
32021 GOSUB ADJUST_XY
32025 LET [email protected](_OBJ_C),[email protected](_OBJ_L),_LINE$="'LINE'("+STR(X1)+","+STR(Y1)+","+
32025:_OBJ_NULL$+")"
32030 PRINT _I1$,_OBJ_ATTR$,'PEN'(NUM(PEN_STYLE$),PEN_WIDTH,NUM(PEN_COLOUR$)),E
32030:VS(_LINE$),'RM',_I2$,
32040 RETURN
33000 ! ^100 - Pie
33010 DISP_PIE:
33020 GOSUB SHAPES_INFO
33030 PRINT _I1$,_OBJ_ATTR$,'PEN'(NUM(PEN_STYLE$),PEN_WIDTH,NUM(PEN_COLOUR$)),'
33030:FILL'(NUM(FILL_PATTERN$),NUM(FILL_COLOUR$)),'PIE'(@X(_OBJ_C),@Y(_OBJ_L),@
33030:X(RADIUS*_ADJ_W)-_AT_X0,RATIO,START_ANGLE,END_ANGLE),'RM',_I2$,
33040 RETURN
34000 ! ^100 - Polygon
34010 DISP_POLYGON:
34015 IF _OBJ_NULL$="" THEN RETURN
34020 GOSUB SHAPES_INFO
34021 GOSUB ADJUST_XY
34022 LET TMP$=STR(@X(_OBJ_C))+","+STR(@Y(_OBJ_L))+","+_OBJ_NULL$,TMP$=STP(TMP$
34022:,1,",")
34025 LET _POLYGON$="'POLYGON'("+TMP$+")"
34030 PRINT _I1$,_OBJ_ATTR$,'PEN'(NUM(PEN_STYLE$),PEN_WIDTH,NUM(PEN_COLOUR$)),'
34030:FILL'(NUM(FILL_PATTERN$),NUM(FILL_COLOUR$)),EVS(_POLYGON$),'RM',_I2$,
34040 RETURN
35000 ! ^100 - Rectangle
35010 DISP_RECTANGLE:
35020 GOSUB SHAPES_INFO
35030 PRINT _I1$,_OBJ_ATTR$,'PEN'(NUM(PEN_STYLE$),PEN_WIDTH,NUM(PEN_COLOUR$)),'
35030:FILL'(NUM(FILL_PATTERN$),NUM(FILL_COLOUR$)),'RECTANGLE'(@X(_OBJ_C),@Y(_OB
35030:J_L),@X(_OBJ_C+_OBJ_W),@Y(_OBJ_L+_OBJ_H)),'RM',_I2$,
35040 RETURN
40000 ! ^100 - Parse shapes info and assign group image
40010 SHAPES_INFO:
40020 LET _PEN_INFO$=_OBJ_DEF$,PEN_STYLE$="0",PEN_COLOUR$="0",PEN_WIDTH=0; IF _
40020:PEN_INFO$<>"" THEN TRANSLATE _PEN_INFO$,SEP,","; READ DATA FROM _PEN_INFO
40020:$ TO PEN_STYLE$,PEN_WIDTH,PEN_COLOUR$
40030 LET _FILL_INFO$=_OBJ_IDX$,FILL_PATTERN$="0",FILL_COLOUR$="0"; IF _FILL_IN
40030:FO$<>"" THEN TRANSLATE _FILL_INFO$,SEP,","; READ DATA FROM _FILL_INFO$ TO
40030: FILL_PATTERN$,FILL_COLOUR$
40035 IF POS(_OBJ_TYPE$="^/") THEN GOTO 40070
40040 LET RADIUS=0,RATIO=0; IF _OBJ_NULL$<>"" THEN LET _P=POS(","=_OBJ_NULL$);
40040:IF _P<>0 THEN LET RADIUS=NUM(_OBJ_NULL$(1,_P-1)),RATIO=NUM(_OBJ_NULL$(_P+
40040:1))
40050 LET START_ANGLE=0,END_ANGLE=0; IF _OBJ_INP$<>"" THEN LET _P=POS(","=_OBJ_
40050:INP$); IF _P<>0 THEN LET START_ANGLE=NUM(_OBJ_INP$(1,_P-1)),END_ANGLE=NUM
40050:(_OBJ_INP$(_P+1))
40070 IF POS("h"=_OBJ_STS$)<>0 THEN RETURN
40080 GOSUB ATTR_CHK
40090 LET _G$=_CUR_IMG$+_OBJ_K$(13)
40100 IF _OBJ_GRP$<>"" THEN GOSUB DEF_GRP
40110 LET _I1$='IMAGE'(_G$),_I2$=""
40120 IF _F_IMAGES$<>"" THEN LET _F_IMAGES$=_F_IMAGES$+'IMAGE'(DELETE _G$)
40130 RETURN
40500 ! ^500 - Adjust x and y coordinates for panel resize
40510 ADJUST_XY:
40512 IF _AT_X0=0 AND _AT_Y0=0 AND _ADJ_C=1 AND _ADJ_L=1 AND _ADJ_W=1 AND _ADJ_
40512:H=1 THEN RETURN
40520 LET _X$=_OBJ_NULL$+",",_OBJ_NULL$=""
40530 IF _X$="" THEN GOTO 40570
40540 LET _O=POS(","=_X$),_XX$=_X$(1,_O-1),_X=EVN(_X$(1,_O-1))
40541 IF POS("@X"=UCS(_XX$)) THEN LET [email protected](0)
40542 IF _SMART_RESIZE=0 THEN LET _X=_X*_ADJ_C ELSE IF _SIZE_CODE$="F" THEN LET
40542: _X=(_OBJ_C*_AT_X1)+(_X-(_ORIG_C*_AT_X1)) ELSE LET _X=(_OBJ_C*_AT_X1)+((_
40542:X-(_ORIG_C*_AT_X1))*_RSZ_ADJ_W)
40543 LET _X+=_AT_X0
40545 LET _OBJ_NULL$+=STR(_X)+",",_X$=_X$(_O+1)
40550 LET _O=POS(","=_X$),_XX$=_X$(1,_O-1),_X=EVN(_X$(1,_O-1)); IF POS("@Y"=UCS
40550:(_XX$)) THEN LET [email protected](0)
40551 IF _SMART_RESIZE=0 THEN LET _X=_X*_ADJ_L ELSE IF _SIZE_CODE$="F" THEN LET
40551: _X=(_OBJ_L*_AT_Y1)+(_X-(_ORIG_L*_AT_Y1)) ELSE LET _X=(_OBJ_L*_AT_Y1)+((_
40551:X-(_ORIG_L*_AT_Y1))*_RSZ_ADJ_H)
40553 LET _X+=_AT_Y0
40555 LET _OBJ_NULL$+=STR(_X)+",",_X$=_X$(_O+1)
40560 GOTO 40530
40570 LET _OBJ_NULL$=STP(_OBJ_NULL$,1,",")
40580 RETURN
45000 ! ^45000 - Smart listbox logic
45010 SETUP_SMART_LBX:
45020 LET _QLST_FLG=1,_QRY_TBL$[ID-10000]=""; LET _QLST_IDX+=1,_QLST_CTL[_QLST_
45020:IDX]=ID,_QLST_REC$[_QLST_IDX]=""
45030 LET _QLST_QRY$[_QLST_IDX]=_OBJ_QRY$
45040 IF LEN(_OBJ_DEF$)<=1 THEN LET _QLST_IOL$[_QLST_IDX]="",_QLST_TST$[_QLST_I
45040:DX]="" ELSE LET _P=POS(";"=_OBJ_DEF$); IF _P=0 THEN LET _QLST_IOL$[_QLST_
45040:IDX]=_OBJ_DEF$(2),_QLST_TST$[_QLST_IDX]="" ELSE LET _QLST_IOL$[_QLST_IDX]
45040:=_OBJ_DEF$(2,_P-2),_QLST_TST$[_QLST_IDX]=_OBJ_DEF$(_P+1)
45045 IF LEN(_OBJ_LOGIC1$)>3 THEN IF _OBJ_LOGIC1$(1,3)="C"";" OR _OBJ_LOGIC1$(1
45045:,3)="P"";" THEN LET _OBJ_LOGIC1$=_OBJ_LOGIC1$(1,2)+_P$+_OBJ_LOGIC1$(3)
45048 IF LEN(_OBJ_LOGIC2$)>3 THEN IF _OBJ_LOGIC2$(1,3)="C"";" OR _OBJ_LOGIC2$(1
45048:,3)="P"";" THEN LET _OBJ_LOGIC2$=_OBJ_LOGIC2$(1,2)+_P$+_OBJ_LOGIC2$(3)
45051 LET _QLST_PRE$[_QLST_IDX]=_OBJ_LOGIC1$,_QLST_POST$[_QLST_IDX]=_OBJ_LOGIC2
45051:$
45060 IF INIT_VAL$="" THEN LET _QLST_SEL$[_QLST_IDX]="" ELSE LET _QLST_SEL$[_QL
45060:ST_IDX]=INIT_VAL$
45070 IF _OBJ_TYPE$="L" AND _OBJ_LISTBOX_TYPE$="F" AND _OBJ_NULL$="" THEN LET _
45070:FMT_LBX$="L1"
45071 LET _QLST_FMT$[_QLST_IDX]=_FMT_LBX$
45080 RETURN
45100 ! ^100
45110 SETUP_SMART_LBX_IOLISTS:
45120 FOR _IDX=_QLST_MAIN_PNL_IDX+1 TO _QLST_IDX
45130 LET _QLST_BTN$[_IDX]=""
45140 IF _QLST_IOL$[_IDX]="" THEN CONTINUE
45150 IF _QLST_BTN$="" THEN GOTO 45210
45160 LET _X$=_QLST_IOL$[_IDX]
45170 LET _O=POS(","=_X$); IF _O=0 THEN GOTO 45200
45180 LET _TMP$=_X$(1,_O-1); IF POS(","+_TMP$+","=","+_QLST_BTN$) THEN LET _QLS
45180:T_BTN$[_IDX]+="_qlst_"+STP(_TMP$,1,"$")+","
45190 LET _X$=_X$(_O+1); GOTO 45170
45200 IF _QLST_BTN$[_IDX]<>"" THEN LET _QLST_BTN$[_IDX]=CPL("IOLIST "+STP(_QLST
45200:_BTN$[_IDX],1,","))
45210 LET _QLST_IOL$[_IDX]=CPL("IOLIST "+STP(_QLST_IOL$[_IDX],1,","))
45220 NEXT _IDX
45230 RETURN
45500 ! ^500
45510 LOAD_AUTO_LISTS:
45520 IF _QLST_IDX=0 THEN RETURN
45530 FOR _IDX=1 TO _QLST_IDX
45540 IF _QLST_IOL$[_IDX]="" THEN LET _QLST_REC$=SEP ELSE LET _QLST_REC$=REC(_Q
45540:LST_IOL$[_IDX],ERR=*NEXT)
45550 IF _QLST_BTN$[_IDX]="" THEN LET _QLST_BTN_REC$="" ELSE LET _QLST_BTN_REC$
45550:=REC(_QLST_BTN$[_IDX],ERR=*NEXT)
45560 IF _QLST_REC$<>_QLST_REC$[_IDX] OR _QLST_BTN_REC$<>_QLST_BTN_REC$[_IDX] T
45560:HEN IF _QLST_TST$[_IDX]="" OR EVN(_QLST_TST$[_IDX],ERR=*PROCEED)=1 THEN G
45560:OSUB CALL_WINLIST
45570 LET _QLST_REC$[_IDX]=_QLST_REC$,_QLST_BTN_REC$[_IDX]=_QLST_BTN_REC$
45580 IF _QLST_SEL$[_IDX]<>"" THEN LIST_BOX WRITE _QLST_CTL[_IDX],_QLST_SEL$[_I
45580:DX],ERR=*PROCEED; LET _QLST_SEL$[_IDX]=""
45590 NEXT _IDX
45600 RETURN
45610 CALL_WINLIST:
45612 IF _QLST_PRE$[_IDX]<>"" THEN LET CMD_STR$=_QLST_PRE$[_IDX]; GOSUB 7000; I
45612:F _QLST_IOL$[_IDX]="" THEN LET _QLST_REC$=SEP ELSE LET _QLST_REC$=REC(_QL
45612:ST_IOL$[_IDX],ERR=*NEXT) ! contents of rec may have changed
45615 LET _QLST_QRY$=_QLST_QRY$[_IDX]; IF MID(_QLST_QRY$,1,1)="=" THEN LET _QLS
45615:T_QRY$=EVS(_QLST_QRY$(2)) END_IF ; LET _QP=POS(",;":_QLST_QRY$); IF _QP=0
45615: THEN LET _QLST_LIB$=PTH(%SCR_LIB) ELSE LET _QLST_LIB$=_QLST_QRY$(_QP+1),
45615:_QLST_QRY$=_QLST_QRY$(1,_QP-1)
45617 LET _QLST_CTL=_QLST_CTL[_IDX]; IF _QLST_FMT$[_IDX]<>"" THEN LET _QLST_CTL
45617:'FMT$=_QLST_FMT$[_IDX]
45620 CALL "*winlist",_QLST_QRY$,_QLST_LIB$,_QLST_CTL,_QLST_IOL$[_IDX],_QLST_RE
45620:C$
45630 IF _QLST_POST$[_IDX]<>"" THEN LET CMD_STR$=_QLST_POST$[_IDX]; GOSUB 7000
45640 RETURN
47000 ! ^1000 - Build pop_up menu
47010 BUILD_POPUP_MNU:
47020 IF _POPUP_TBL$[_ID]="" THEN GOTO NXT_INP
47030 LET _POPUP_MENU$=_POPUP_TBL$[_ID],_POPUP_LOGIC$=_POPUP_LOGIC_TBL$[_ID]
47035 IF _POPUP_LOGIC$<>"" THEN LET CMD_STR$=_POPUP_LOGIC$; GOSUB 7000
47040 IF POS("="=_POPUP_MENU$)=1 THEN LET _POPUP_MENU$=EVS(_POPUP_MENU$(2),ERR=
47040:*NEXT)
47045 IF _POPUP_MENU$="" THEN MSGBOX "Sorry.."+SEP+"There is no popup menu avai
47045:lable for this control","Missing Popup Menu","!"; GOTO NXT_INP
47050 LET _P=POS(",;":_POPUP_MENU$); IF _P=0 THEN LET _POPUP_LIB$="",_POPUP_PNL
47050:$=_POPUP_MENU$ ELSE LET _POPUP_LIB$=_POPUP_MENU$(_P+1),_POPUP_PNL$=_POPUP
47050:_MENU$(1,_P-1)
47060 LET _P=%SCR_LIB
47070 IF _POPUP_LIB$<>"" THEN LET _P=GFN; OPEN (_P,ERR=47220)_POPUP_LIB$
47090 LET _POPUP_MNU$=""
47100 READ (_P,KEY=PAD(UCS(_POPUP_PNL$),12)+"M",DOM=*NEXT)
47110 LET _OBJ_K$=KEY(_P,END=POPIT); IF _OBJ_K$(13,1)<>"M" THEN GOTO POPIT
47120 IF _OBJ_K$(13,1)="M" AND _OBJ_K$(14,1)<>" " THEN GOTO POPIT
47130 READ (_P,KEY=_OBJ_K$)IOL=8010
47140 LET _POPUP_MNU$=_POPUP_MNU$+INIT_TEXT$
47150 GOTO 47110
47160 POPIT:
47180 POPUP_MENU _POPUP_MNU$,_POP_CTL,ERR=*NEXT
47190 IF _POP_CTL<17000 THEN GOTO NXT_INP
47200 READ (_P,KEY=PAD(UCS(_POPUP_PNL$),12)+"M"+STR(_POP_CTL-17000:"000"),DOM=4
47200:7220)IOL=8010
47210 GOSUB CHECK_DEF_PRG; LET CMD_STR$=_OBJ_SEL$; GOSUB 7000; GOSUB CLOSE_POPL
47210:IB; GOTO NEXT_ID_CHK
47220 GOSUB CLOSE_POPLIB
47230 GOTO NXT_INP
47240 CLOSE_POPLIB:
47250 IF _P<>%SCR_LIB THEN CLOSE (_P,ERR=*NEXT)
47260 RETURN
50000 ! ^100 - Assign drag on controls
50010 DO_DRAGONS:
50015 IF _DRAGON_CNT=0 THEN RETURN
50020 FOR _Y=1 TO _DRAGON_CNT
50030 DROP EVN(_DRAGON_FR_CTL$[_Y]+".ctl") ON EVN(_DRAGON_TO_CTL$[_Y]+".ctl") R
50030:ETURN _DRAGON_CTL[_Y],ERR=*NEXT
50040 NEXT
50050 RETURN
51000 ! ^100 - Execute drag ctls
51010 DRAG_CTL_CHK:
51020 LET _I=1
51030 IF _I>_DRAGON_CNT THEN RETURN
51035 IF CTL<>_DRAGON_CTL[_I] THEN LET _I=_I+1; GOTO 51030
51040 LET _EOM$=""
51045 LIST_BOX READ EVN(_DRAGON_FR_CTL$[_I]+".CTL"),_X$,_EOM$,ERR=*NEXT
51047 LET _V$=_DRAGON_FR_CTL$[_I]+_SFX$; VIA _V$=_X$
51050 LET CMD_STR$=_DRAGON_CMD$[_I]; GOSUB 7000; GOTO NEXT_ID_CHK
53000 ! ^1000 - Save panel info and restore a panel to its previous location an
53000:d size
53010 GET_PANEL_INFO:
53020 LET _SV_OBJ_TYPE$=_OBJ_TYPE$; IF _SV_OBJ_TYPE$="W" OR TCB(32)<5 THEN RETU
53020:RN
53030 LET _SV_MAX=0,_SV_C=_OBJ_C,_SV_L=_OBJ_L,_SV_W=_OBJ_W,_SV_H=_OBJ_H
53040 CALL %NOMAD_PANEL_INFO_PROG$+";Get_Panel_Info",ERR=CANNOT_ACCESS_PANEL_IN
53040:FO,MAIN_SCRN_K$,PTH(%SCR_LIB),_SV_MAX,_SV_C,_SV_L,_SV_W,_SV_H
53045 CALL "*info;GetwoRKAREAOFFSET",ERR=*NEXT,_XO,_YO
53050 GOSUB GET_XYINFO; LET _SV_C=MAX(0,MIN(_SV_C,INT(%NOMAD_XMAX/%NOMAD_XCHAR)
53050:-10))+_XO; LET _SV_L=MAX(0,MIN(_SV_L,INT(%NOMAD_YMAX/%NOMAD_YCHAR)-3))+_Y
53050:O
53060 IF _SV_C=_OBJ_C AND _SV_L=_OBJ_L THEN LET _PNL_MOVE=0 ELSE LET _PNL_MOVE=
53060:1
53070 IF _SV_W=_OBJ_W AND _SV_H=_OBJ_H THEN LET _PNL_SIZE=0 ELSE LET _PNL_SIZE=
53070:1
53080 RETURN
53090 CANNOT_ACCESS_PANEL_INFO:
53100 LET %NOMAD_PANEL_INFO_PROG$=""
53110 RETURN
53200 ! ^200
53210 RESTORE_PANEL:
53220 IF TCB(32)<5 THEN RETURN ! OR (_pnl_move=0 AND _pnl_size=0 AND _sv_max=0)
53220: THEN RETURN
53230 IF _PNL_SIZE THEN PRINT 'SIZE'(_SV_W,_SV_H),
53250 IF _PNL_SIZE OR _SV_MAX THEN PERFORM "*winproc.rsz;Resize"
53251 IF _SV_MAX THEN PRINT 'SHOW'(-1),
53260 PRINT 'MOVE'(_SV_C,_SV_L),
53265 IF _SV_MAX THEN PRINT 'SHOW'(2),
53270 RETURN
53500 ! ^500
53510 SAVE_PANEL_INFO:
53520 IF _SV_OBJ_TYPE$="W" OR TCB(32)<5 THEN RETURN
53530 LET _X=_SV_MAX,_X1=_SV_C,_X2=_SV_L,_X3=_SV_W,_X4=_SV_H
53540 LET _M$=MSE; IF DEC($00$+MID(_M$,31,1))=2 THEN LET _SV_MAX=1 ELSE LET _SV
53540:_MAX=0
53550 IF _SV_MAX THEN PRINT 'SHOW'(1),
53555 CALL "*info;GetwoRKAREAOFFSET",ERR=*NEXT,_XO,_YO
53560 LET _X$=OBJ(0); LET _SV_C=MAX(0,INT((DEC(_X$(21,2))+1)/DEC($00$+_M$(10,1)
53560:)))-_XO; LET _SV_L=MAX(0,INT((DEC(_X$(23,2))+1)/DEC($00$+_M$(11,1))))-_YO
53560:; LET _SV_W=DEC(_X$(33,2)),_SV_H=DEC(_X$(35,2))
53570 IF (_X<>_SV_MAX) OR (_X1<>_SV_C) OR (_X2<>_SV_L) OR (_X3<>_SV_W) OR (_X4<
53570:>_SV_H) THEN CALL %NOMAD_PANEL_INFO_PROG$+";Save_panel_info",ERR=*NEXT,MA
53570:IN_SCRN_K$,PTH(%SCR_LIB),_SV_MAX,_SV_C,_SV_L,_SV_W,_SV_H
53580 RETURN
55000 ! ^100 - Build action string for dependency table
55010 BUILD_ACTION:
55015 LET _FUNCTIONS$="Enable/Disable/Lock/Unlock/Show/Hide/"
55016 LET _X1$=_X1$+";"
55020 IF _X1$="" THEN RETURN
55030 LET _P=POS(";"=_X1$); IF _P=0 THEN RETURN
55040 LET _XX$=_X1$(1,_P-1),_X1$=_X1$(_P+1)
55050 LET _P=POS(","=_XX$); IF _P=0 THEN GOTO 55020
55060 LET _F1$=_XX$(_P+1),_F2$=_XX$(1,_P-1)
55070 LET _P=POS(_F1$=_FUNCTIONS$); IF _P=0 THEN GOTO 55020
55080 LET _Q=POS("/"=_FUNCTIONS$(_P)); LET _F1$=_FUNCTIONS$(_P,_Q-1)
55083 IF INVERT$="Y" THEN GOSUB INVERT_FUNCTION
55085 IF GROUPED THEN LET _DEPENDS_ACTION$=_DEPENDS_ACTION$+"CALL "+QUO+"*WINGR
55085:P;"+_F1$+QUO+","+_F2$+".GRP$"+";"
55090 IF NOT(GROUPED) THEN LET _DEPENDS_ACTION$=_DEPENDS_ACTION$+_F1$+" CONTROL
55090: "+_F2$+".CTL;"
55100 GOTO 55020
56000 ! ^100 - Dependency table check
56010 DEPENDS_CHK:
56015 IF _DEPENDS_CNT=0 THEN RETURN
56020 FOR _D=1 TO _DEPENDS_CNT
56040 LET _DEPENDS_TRUE=EVN(_DEPENDS_COND_TBL$[_D],ERR=*CONTINUE); IF NOT(_DEPE
56040:NDS_TRUE) THEN LET _DEPENDS_EVN_VALUE[_D]=_DEPENDS_TRUE; CONTINUE
56050 LET CMD_STR$="X"+STP(_DEPENDS_ACTION$[_D],1,";"); GOSUB 7000; LET _DEPEND
56050:S_EVN_VALUE[_D]=_DEPENDS_TRUE; CONTINUE
56090 DEPENDS_ERR:
56100 NEXT
56110 RETURN
57000 ! ^100 - Invert fuunctions
57010 INVERT_FUNCTION:
57020 IF _F1$="Enable" THEN LET _F1$="Disable"; RETURN
57030 IF _F1$="Disable" THEN LET _F1$="Enable"; RETURN
57040 IF _F1$="Lock" THEN LET _F1$="Unlock"; RETURN
57050 IF _F1$="Unlock" THEN LET _F1$="Lock"; RETURN
57060 IF _F1$="Show" THEN LET _F1$="Hide"; RETURN
57070 IF _F1$="Hide" THEN LET _F1$="Show"; RETURN
57080 RETURN
58000 ! ^100 - Load depends tables
58010 LOAD_DEPENDS_TBL:
58020 LET _DEPENDS_CNT=_DEPENDS_CNT+1,_DEPENDS_ACTION$=""
58030 IF INVERT$="Y" THEN LET _DEPENDS_COND_TBL$[_DEPENDS_CNT]="NOT("+_OBJ_SEL$
58030:+")" ELSE LET _DEPENDS_COND_TBL$[_DEPENDS_CNT]=_OBJ_SEL$
58040 LET _X1$=_OBJ_NULL$,GROUPED=1; GOSUB BUILD_ACTION; LET _DEPENDS_ACTION$[_
58040:DEPENDS_CNT]=_DEPENDS_ACTION$
58050 LET _X1$=_OBJ_DEF$,GROUPED=0; GOSUB BUILD_ACTION; LET _DEPENDS_ACTION$[_D
58050:EPENDS_CNT]=_DEPENDS_ACTION$
58060 RETURN
Volver arriba
Oldno7
Administrador del Foro
Administrador del Foro


Registrado: 22 Mar 2002
Mensajes: 1829

MensajePublicado: Mie 24 May 2006 12:55:52    Asunto: Responder citando

La gente empieza a pensar que estamos poseidos por algun extraño espiritu extraterrenal...

Es que estas empezando a presumir... Smile
Me llaman la atencion tanto las enormes similitudes (es logico: los dos son BB que provienen del mismo ancestro evolutivo -guiño a mis compañeros del foro sobre evolucion-) como las diferencias con el BB de thoroughbred.

Ahora me pilla fatal.. pero a ver si antes de que acabe el verano le echo un vistazo a fondo al asunto y podemos tener una conversacion "entre pares".
_________________
Ojala vivas en tiempos interesantes.
(antigua maldicion china)
Volver arriba
Ver perfil de usuario Enviar mensaje privado Enviar email Visitar sitio web del autor Yahoo Messenger
David (Moralzarzal)
Extraterrestre
Extraterrestre


Registrado: 06 Nov 2002
Mensajes: 745
Ubicación: Madrid

MensajePublicado: Mie 24 May 2006 13:37:50    Asunto: Responder citando

;)

http://www.oreilly.com/news/graphics/prog_lang_poster.pdf
_________________
Subgrupo [email protected]



Sólo el estanque tranquilo refleja las estrellas
Volver arriba
Ver perfil de usuario Enviar mensaje privado Enviar email
Oldno7
Administrador del Foro
Administrador del Foro


Registrado: 22 Mar 2002
Mensajes: 1829

MensajePublicado: Mie 24 May 2006 13:50:42    Asunto: Responder citando

muy chulo el poster Smile
pero como siempre, me siento un elemento marginal, un callejon sin salida de la evolucion...
fijate que ahi el unico Basic que parece es el que desemboca en el VB de micropuagh...


EQUIDNAS, UNIOS!!!!!

UUUUUUUUKACHAKAAAA!! UH! UH! AAAAAUH!
_________________
Ojala vivas en tiempos interesantes.
(antigua maldicion china)
Volver arriba
Ver perfil de usuario Enviar mensaje privado Enviar email Visitar sitio web del autor Yahoo Messenger
invitado-2
Invitado





MensajePublicado: Mie 24 May 2006 16:43:27    Asunto: Responder citando

El más antiguo que conozco

http://www.gdma.com/about_us.htm

EL DESCONOCIMIENTO GENERAL SOBRE LOS BASICS ES ABSOLUTO.

En sistemas IBM-36 ya existía un Basic llamado Pluto.
Olivetti en sus minis tenían Basic de Gestión.
HP también lo tenía.
Nichdorf (no recuerdo como se escribía) también lo tenía.
También estaba el TEOS.

Lo que pasa que todos estos Basics (los buenos) NO SON GRATIS.

HAY QUE PAGARLOS
Volver arriba
invitado-2
Invitado





MensajePublicado: Mie 24 May 2006 16:50:22    Asunto: Responder citando

más ...

http://www.faqs.org/faqs/business-basic/faq/
Volver arriba
Oldno7
Administrador del Foro
Administrador del Foro


Registrado: 22 Mar 2002
Mensajes: 1829

MensajePublicado: Mie 24 May 2006 18:30:12    Asunto: Responder citando

uff.. esa es la faq de Gary Mclellan del '97 ... ahora hay un par de listas con cierto movimiento
de BB, son la montada por el propio Gary en
[email protected]
que ultimamente solo sirve para anunciar vacantes en puestos de trabajo como programador de
BB, y tambien la que ha montado Thoroughbred, pero en la que participan BBeros de todas las disciplinas. es accesible via
http://www.tbred.com/list_guidelines.html

Como decian al principio de una buena peli que recuerdo con cariño:
"el mundo se ha movido...."

(no!! no es Serenity! ñeñeñeñeñeñeñeñe)
por cierto que me he comprado la serie "FireFly".. ta mumien tamien...
_________________
Ojala vivas en tiempos interesantes.
(antigua maldicion china)
Volver arriba
Ver perfil de usuario Enviar mensaje privado Enviar email Visitar sitio web del autor Yahoo Messenger
invitado-2
Invitado





MensajePublicado: Mie 24 May 2006 20:25:08    Asunto: Responder citando

En esta página se pueden ver las pantallas de Nomads
que están hechas por el propio Nomads.

http://www.softnetconsult.com/ps_nmd_es.htm
Volver arriba
invitado-2
Invitado





MensajePublicado: Vie 26 May 2006 17:29:02    Asunto: Responder citando

Para Oldno7

EXTRACT (chan[,fileopt])varlist

Where:

chan Channel or logical file number of the file from which to read the data.
fileopt Supported file options (see also, File Options): BSY=stmtref Traps Error #0: Record/file busy
DOM=stmtref Missing record transfer
END=stmtref End-Of-File transfer
ERR=stmtref Error transfer
IND=num Record index
KEY=string$ Record key
KNO=num | name$ File access key number (num) or name (name$)
REC=name$ Record prefix (REC=VIS(string$) can also be used)
RNO=num Record number
RTY=num Number of retries (one second intervals)
SIZ=num Number characters to read
TBL=stmtref Data translation table
TIM=num Maximum time-out value in integer seconds.

varlist Comma-separated list of variables, literals or IOL= options.


Use EXTRACT to read data from the file you specify as the channel. When ProvideX reads the data, it is split into one or more fields (either separated by the current delimiter or in an embedded IOList format) with the contents of the first field placed into variable 1, the second field into variable 2, and so on.
ProvideX automatically converts numeric data when moving it into numeric variables while processing the EXTRACT directive. Numeric data converted during an EXTRACT directive does not use the 'DP' Decimal Point Symbol or 'TH' Thousands Separator system parameters for European decimal settings.

If you want a field to be skipped, use an asterisk '*' as a place holder for a variable name. If you specify more variables than there are fields in the record, ProvideX will initialize the additional variables to either zero (if a numeric variable) or a null string (if a string variable). The EXTRACT directive advances the file position to the next record (or a record you can specify using the KEY= or IND= option). Use the KNO= option to change the current file access key.

*Note* EXTRACT locks the record being read to prevent other users from using a FIND, FIND RECORD, READ, READ RECORD, EXTRACT RECORD or another EXTRACT to access it. This lock stays active until the next I/O request for the same file or until the file is closed. Using a KEY= option or READ, FIND or EXTRACT statement to retrieve the next record while a record is locked will result in the locked record being returned instead.

You can enable read access for records that have been extracted by setting the 'XI' parameter.

ES IMPORTANTE ...
Volver arriba
Mostrar mensajes de anteriores:   
Publicar nuevo tema   Responder al tema    Foros de discusión -> Informática y Ordenadores Todas las horas son GMT + 2 Horas
Ir a página 1, 2  Siguiente
Página 1 de 2

 
Cambiar a:  
Puede publicar nuevos temas en este foro
Puede responder a temas en este foro
No puede editar sus mensajes en este foro
No puede borrar sus mensajes en este foro
No puede votar en encuestas en este foro


Powered by phpBB © 2001, 2004 phpBB Group
 

Página alojada en http://www.Oldno7.org


Fotomaf - Galeria de fotos de Mauro A. Fuentes