home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Carsten's PPE Collection
/
Carstens_PPE_Collection_2007.zip
/
T
/
TLY-BRD2.ZIP
/
CY_BRD.PPS
< prev
next >
Wrap
Text File
|
1995-04-28
|
17KB
|
665 lines
Integer indice, Max, CurCol, Curlgn, NbCol, Nblgn, stalgn, keycol
Integer MinLgn, Curind, Nivsec[90], j, Col[10], stacol, kbuflen
String Touche, TabLis[90], Csel, Cnor, Cpri, Tabul, Keycoul, Maincmd, Minispeed
String Carsec, Prim[90], TmpKey, Statut, Chemin, fconf, fich[3], comm, Conni
String fillb, tmptok
;******************************************************************
;** init les var et crée un fich. temp. pour la pos. du curs.
;******************************************************************
LET Curcol = 1
LET Curind = 1
LET indice = 1
LET Tmpkey = ""
LET fillb = ""
TOKENIZE TOKENSTR() ;regarde les paramètres passés au ppe
LET chemin = PPEPATH()
LET fconf = GETTOKEN()
IF (fconf<>"") GOTO init
PRINTLN "@X0FP@X0Au@X02T @X0FT@X0Ah@X02E @X0FN@X0Aa@X02Me @X0Fo@X0AF @X0Ft@X0AH@X02e @X0FC@X0Ao@X02nFIguRaTIon @X0FF@X0Ai@X02lE @X0Fa@X0AS @X0FA @X0FP@X0Aa@X02RAmETeR !"
PRINTLN "eX : !C:\PCB\PPE\MEN\MEN.PPE BRDCNF"
WAIT
END
:init
IF (EXIST(fconf)) GOTO gone
IF (!EXIST(chemin+fconf)) GOTO errconf
LET fconf = chemin+fconf
GOTO gone
:errconf
PRINTLN "@X0FC@X0Ao@X02NFiGuRATiOn @X0Ff@X0AI@X02Le @X0FN@X0AO@X02t @X0FF@X0Ao@X02UnD @X0Fo@X0AN @X0FD@X0Ai@X02SK"
WAIT
END
;****************************************************************************
;** range les lignes de txt du menu (fichier de configuration)
;****************************************************************************
:gone
FOPEN 2,"PCBOARD.SYS",O_RD,S_DN
FSEEK 2,18,1
FREAD 2,CONNI,5
FCLOSE 2
FOPEN 1,fconf+LANGEXT(),O_RD,S_DN
FGET 1,fich[1] ;nom fich. cadre
FGET 1,fich[2] ; " fich. barre stat
FGET 1,fich[3] ; " fich. menu statique
FGET 1,Minispeed
FGET 1,Maincmd
FGET 1,Nblgn
FGET 1,MinLgn
LET Curlgn = Minlgn
FGET 1,Tabul
TOKENIZE Tabul
GETTOKEN Col[indice]
WHILE (Col[indice]<>"") DO
INC indice
GETTOKEN Col[indice]
ENDWHILE
FGET 1,Cnor
FGET 1,Csel
FGET 1,Cpri
FGET 1,Carsec
Carsec = Carsec+" "
LET indice = 1
WHILE (!(FERR(1))) DO
FGET 1,TabLis[indice]
IF (TabLis[indice] == "<EOL>") GOTO LABEL01
FGET 1,Prim[indice]
FGET 1,Nivsec[indice]
INC indice
ENDWHILE
FCLOSE 1
GOTO ErrLis
:LABEL01
FCLOSE 1
Max = indice-1
Nbcol = (Max-1)/Nblgn
;************************************************************************
;** affiche le cadre et le statut
;************************************************************************
:LABEL02
FOPEN 4,chemin+fich[2]+LANGEXT(),O_RD,S_DN
IF (FERR(4)) THEN
GOTO errsta
ELSE
FGET 4,stacol
FGET 4,Stalgn
FGET 4,keycol
FGET 4,kbuflen
FGET 4,keycoul
FGET 4,Statut
FCLOSE 4
ENDIF
FOR indice = 1 TO kbuflen
fillb = fillb + " "
NEXT
GETUSER
IF (U_EXPERT) GOTO eslab ; to see if xpert mode is on (=> no menu :)
IF ( UPPER(CONNI) == "LOCAL" ) GOTO letsgo
IF ( CONNI < MiniSpeed ) GOTO affmenu
:letsgo
CLS
DISPSTR "%"+chemin+fich[1]+LANGEXT()
ANSIPOS stacol,stalgn
PRINT statut
;******************************************************************
;** écrit les lignes
;******************************************************************
:LABEL03
FOR j = 1 TO (Nbcol+1)
Curlgn = Minlgn
Curcol = j
FOR indice = 1 TO Nblgn
IF ( ((j-1)*NbLgn)+indice > Max) GOTO Endmenu
IF (CURSEC() >= NivSec[((j-1)*Nblgn)+indice]) THEN
ANSIPOS Col[CurCol], Curlgn
IF (TabLis[((j-1)*Nblgn)+indice] <> "") THEN
PRINT Carsec+Cnor+TabLis[((j-1)*Nblgn)+indice]
ANSIPOS Col[CurCol], Curlgn
PRINT Carsec+Cpri+Prim[((j-1)*Nblgn)+indice]
ELSE PRINT ""
ENDIF
ELSE
ANSIPOS Col[CurCol], Curlgn
IF (TabLis[((j-1)*Nblgn)+indice] <> "") THEN
PRINT " "+Cnor+TabLis[((j-1)*Nblgn)+indice]
ANSIPOS Col[CurCol], Curlgn
PRINT " "+Cpri+Prim[((j-1)*Nblgn)+indice]
ELSE PRINT ""
ENDIF
ENDIF
INC Curlgn
NEXT
NEXT
:Endmenu
Tablis[Max+1] = ""
;initialise la sélection
LET Curlgn = Minlgn ;prendre les val. du fich. temp
LET Curcol = 1 ;pour le node en cours...
IF (CURSEC() >= Nivsec[Curind]) THEN
IF (Tablis[curind]<>"") THEN
ANSIPOS col[Curcol],Curlgn
PRINT Carsec+Csel+Tablis[Curind]
ANSIPOS col[Curcol],Curlgn
PRINT Carsec+Cpri+Prim[1]
ELSE
WHILE ((Tablis[Curind]=="")&&(Curind<Max)) DO
INC Curind
INC Curlgn
IF (Curlgn>Nblgn) THEN
INC Curcol
Curlgn = 1
ENDIF
ENDWHILE
ANSIPOS col[Curcol],Curlgn
PRINT Carsec+Csel+Tablis[Curind]
ANSIPOS col[Curcol],Curlgn
PRINT Carsec+Cpri+Prim[1]
ENDIF
ELSE
IF (Tablis[curind]<>"") THEN
ANSIPOS col[Curcol],Curlgn
PRINT " "+Csel+Tablis[Curind]
ANSIPOS col[Curcol],Curlgn
PRINT " "+Cpri+Prim[1]
ELSE
WHILE ((Tablis[curind]=="")&&(Curind<Max)) DO
INC curind
INC Curlgn
IF (Curlgn>Nblgn) THEN
INC Curcol
Curlgn = 1
ENDIF
ENDWHILE
ANSIPOS col[Curcol],Curlgn
PRINT " "+Csel+Tablis[Curind]
ANSIPOS col[Curcol],Curlgn
PRINT " "+Cpri+Prim[1]
ENDIF
ENDIF
;******************************************************************
;** lit la touche appuyée
;******************************************************************
:readtouche
LET touche = ""
LET Touche = UPPER(INKEY())
IF ( (Touche == "UP") | (Touche == "8") ) THEN
GOSUB Uplab
ELSEIF ( (Touche == "DOWN") | (Touche == "2") ) THEN
GOSUB dwlab
ELSEIF ( (Touche == "RIGHT") | (Touche == "6") ) THEN
GOSUB rglab
ELSEIF ( (Touche == "LEFT") | (Touche == "4") ) THEN
GOSUB lflab
ELSEIF (Touche == CHR(13)) THEN
GOSUB crlab
ELSEIF (Touche == CHR(8)) THEN
GOSUB bklab
ELSEIF (Touche == CHR(27)) THEN
GOSUB eslab
ELSEIF (Touche <> "") THEN
GOSUB autrelab
ENDIF
GOTO readtouche
;******************************************************************
;** affiche une erreur pour le fich. de conf.
;******************************************************************
:ErrLis
PRINTLN Touche
CLS
PRINTLN "@X0FE@X0Ar@X02RoR @X0F: @X0FC@X0Aa@X02N'T @X0FR@X0Ae@X02Ad @X0Ft@X0AH@X02E @X0Fc@X0AO@X02NfIGuRAtiOn @X0Ff@X0AI@X02lE"
WAIT
END
;******************************************************************
;** affiche une erreur pour le fich. de barre de statut
;******************************************************************
:Errsta
PRINTLN Touche
CLS
PRINTLN "@X0F@X0FE@X0Ar@X02RoR @X0F: @X0FC@X0Aa@X02N'T @X0FR@X0Ae@X02Ad @X0Ft@X0AH@X02E @X0Fs@X0AT@X02AtUs @X0Fb@X0AA@X02r @X0Ff@X0AI@X02lE"
WAIT
END
;******************************************************************
;** gère la touche UP ou 8
;******************************************************************
:Uplab
ANSIPOS Keycol,stalgn
PRINT fillb
LET Touche = ""
IF (CurLgn-1<MinLgn) RETURN
LET indice = curind-1
LET j = curlgn-1
WHILE ( Tablis[indice]=="" ) DO
DEC indice
DEC j
IF (j < MinLgn ) RETURN
ENDWHILE
IF (CURSEC() >= NivSec[Curind]) THEN
ANSIPOS col[Curcol], Curlgn
IF (Tablis[curind]<>"") THEN
PRINT Carsec+Cnor+Tablis[Curind]
ANSIPOS col[Curcol], Curlgn
PRINT Carsec+Cpri+Prim[Curind]
ELSE
ANSIPOS col[Curcol],Curlgn
PRINT Carsec+Csel+Tablis[Curind]
ANSIPOS col[Curcol],Curlgn
PRINT Carsec+Cpri+Prim[1]
ENDIF
ELSE
IF (Tablis[curind]<>"") THEN
ANSIPOS col[Curcol], Curlgn
PRINT " "+Cnor+Tablis[Curind]
ANSIPOS col[Curcol], Curlgn
PRINT " "+Cpri+Prim[Curind]
ELSE
ANSIPOS col[Curcol],Curlgn
PRINT " "+Csel+Tablis[Curind]
ANSIPOS col[Curcol],Curlgn
PRINT " "+Cpri+Prim[1]
ENDIF
ENDIF
LET indice = curind-1
LET j = curlgn-1
WHILE ( Tablis[indice]=="" ) DO
DEC indice
DEC j
IF (j < MinLgn ) RETURN
ENDWHILE
LET CurLgn = j
LET Curind = indice
ANSIPOS col[Curcol],Curlgn
IF (CURSEC() >= NivSec[Curind]) THEN
PRINT Carsec+Csel+Tablis[Curind]
ANSIPOS col[Curcol], Curlgn
PRINT Carsec+Cpri+Prim[Curind]
ELSE
PRINT " "+Csel+Tablis[Curind]
ANSIPOS col[Curcol], Curlgn
PRINT " "+Cpri+Prim[Curind]
ENDIF
LET Tmpkey = ""
RETURN
;******************************************************************
;** gère la touche DOWN ou 2
;******************************************************************
:Dwlab
ANSIPOS Keycol,stalgn
PRINT fillb
LET Touche = ""
IF ((Curind +1)>Max) RETURN
IF (CurLgn > NbLgn+Minlgn-2) RETURN
LET indice = curind+1
LET j = curlgn+1
WHILE ( Tablis[indice]=="" ) DO
INC indice
INC j
IF (j > NbLgn+Minlgn-1 ) RETURN
ENDWHILE
IF (CURSEC() >= NivSec[Curind]) THEN
ANSIPOS Col[Curcol], Curlgn
PRINT Carsec+Cnor+Tablis[Curind]
ANSIPOS col[Curcol], Curlgn
PRINT Carsec+Cpri+Prim[Curind]
ELSE
ANSIPOS Col[Curcol], Curlgn
PRINT " "+Cnor+Tablis[Curind]
ANSIPOS col[Curcol], Curlgn
PRINT " "+Cpri+Prim[Curind]
ENDIF
LET indice = curind+1
LET j = curlgn+1
WHILE ( Tablis[indice]=="" ) DO
INC indice
INC j
IF (j > NbLgn+Minlgn-1 ) RETURN
ENDWHILE
LET Curlgn = j
LET Curind = indice
ANSIPOS Col[Curcol],Curlgn
IF (CURSEC() >= NivSec[Curind]) THEN
PRINT Carsec+Csel+Tablis[Curind]
ANSIPOS col[Curcol], Curlgn
PRINT Carsec+Cpri+Prim[Curind]
ELSE
PRINT " "+Csel+Tablis[Curind]
ANSIPOS col[Curcol], Curlgn
PRINT " "+Cpri+Prim[Curind]
ENDIF
LET Tmpkey = ""
RETURN
;******************************************************************
;** gère la touche RIGHT ou 6
;******************************************************************
:rglab
ANSIPOS Keycol,stalgn
PRINT fillb
LET Touche = ""
IF (CurCol>Nbcol) RETURN
IF (Tablis[Curind+Nblgn] == "") THEN
LET indice = Curind+Nblgn
LET j = Curlgn
WHILE (Tablis[indice]=="") DO
DEC j
DEC indice
IF (j<Minlgn) GOTO rplab
ENDWHILE
GOTO rolab
:rplab
LET indice = Curind+Nblgn
LET j = Curlgn
WHILE (Tablis[indice]=="") DO
INC j
INC indice
IF (j>Minlgn+Nblgn-1) RETURN
ENDWHILE
ENDIF
:rolab
IF (CURSEC() >= NivSec[Curind]) THEN
ANSIPOS Col[Curcol],Curlgn
PRINT Carsec+Cnor+Tablis[Curind]
ANSIPOS col[Curcol], Curlgn
PRINT Carsec+Cpri+Prim[Curind]
ELSE
ANSIPOS Col[Curcol],Curlgn
PRINT " "+Cnor+Tablis[Curind]
ANSIPOS col[Curcol], Curlgn
PRINT " "+Cpri+Prim[Curind]
ENDIF
LET indice = Curind+Nblgn
LET j = Curlgn
WHILE (Tablis[indice]=="") DO
DEC j
DEC indice
IF (j<Minlgn) GOTO rplab02
ENDWHILE
GOTO rolab02
:rplab02
LET indice = Curind+Nblgn
LET j = Curlgn
WHILE (Tablis[indice]=="") DO
INC j
INC indice
IF (j>Minlgn+Nblgn-1) RETURN
ENDWHILE
:rolab02
INC Curcol
LET Curlgn = j
LET Curind = indice
ANSIPOS Col[Curcol],Curlgn
IF (CURSEC() >= NivSec[Curind]) THEN
PRINT Carsec+Csel+Tablis[Curind]
ANSIPOS col[Curcol], Curlgn
PRINT Carsec+Cpri+Prim[Curind]
ELSE
PRINT " "+Csel+Tablis[Curind]
ANSIPOS col[Curcol], Curlgn
PRINT " "+Cpri+Prim[Curind]
ENDIF
LET Tmpkey = ""
RETURN
;******************************************************************
;** gère la touche LEFT ou 4
;******************************************************************
:lflab
ANSIPOS Keycol,stalgn
PRINT fillb
LET Touche = ""
IF (CurCol-1<1) RETURN
IF (Tablis[Curind-Nblgn] == "") THEN
LET indice = Curind-Nblgn
LET j = Curlgn
WHILE (Tablis[indice]=="") DO
DEC j
DEC indice
IF (j<Minlgn)GOTO lplab
ENDWHILE
GOTO lolab
:lplab
LET indice = Curind-Nblgn
LET j = Curlgn
WHILE (Tablis[indice]=="") DO
INC j
INC indice
IF (j>Minlgn+Nblgn-1) RETURN
ENDWHILE
ENDIF
:lolab
IF (CURSEC() >= NivSec[Curind]) THEN
ANSIPOS Col[Curcol],Curlgn
PRINT Carsec+Cnor+Tablis[Curind]
ANSIPOS col[Curcol], Curlgn
PRINT Carsec+Cpri+Prim[Curind]
ELSE
ANSIPOS Col[Curcol],Curlgn
PRINT " "+Cnor+Tablis[Curind]
ANSIPOS col[Curcol], Curlgn
PRINT " "+Cpri+Prim[Curind]
ENDIF
LET indice = Curind-Nblgn
LET j = Curlgn
WHILE (Tablis[indice]=="") DO
DEC j
DEC indice
IF (j<Minlgn)GOTO lplab02
ENDWHILE
GOTO lolab02
:lplab02
LET indice = Curind-Nblgn
LET j = Curlgn
WHILE (Tablis[indice]=="") DO
INC j
INC indice
IF (j>Minlgn+Nblgn-1) RETURN
ENDWHILE
:lolab02
DEC Curcol
LET Curlgn = j
LET Curind = indice
ANSIPOS Col[Curcol],Curlgn
IF (CURSEC() >= NivSec[Curind]) THEN
PRINT Carsec+Csel+Tablis[Curind]
ANSIPOS col[Curcol], Curlgn
PRINT Carsec+Cpri+Prim[Curind]
ELSE
PRINT " "+Csel+Tablis[Curind]
ANSIPOS col[Curcol], Curlgn
PRINT " "+Cpri+Prim[Curind]
ENDIF
LET Tmpkey = ""
RETURN
;******************************************************************
;** gère la touche RC
;******************************************************************
:crlab
LET Touche = ""
LET Tmpkey = ""
IF (CURSEC() >= NivSec[Curind]) THEN
CLS
Touche = Prim[Curind]
KBDSTUFF Touche
ELSE RETURN
ENDIF
END
;******************************************************************
;** gère la touche ESC
;******************************************************************
:eslab
CLS
ANSIPOS stacol,stalgn
PRINT statut
LET Touche = ""
LET Tmpkey = ""
ANSIPOS 1,2
PRINTLN "@X09≡ @X0Fc@X09A@X01RrIEr @X0FS@X09p@X01EeD : @X0D"+CONNI+" @X09≡ @X0Fb@X09Y@X01tES @X0Fc@X09R@X01EdItS : @X0D@BYTECREDIT@"
INPUTSTR Maincmd,comm,08h,40,MASK_ASCII(),110h
IF (UPPER(comm) == "") THEN
KBDSTUFF "^M"
END
ENDIF
TOKENIZE comm
GETTOKEN tmptok
GOSUB afflog
CLS
FOR indice = 1 TO Max
IF (UPPER(tmptok) == Prim[indice]) GOTO esTrouve
NEXT
GOTO esNtrouve
:esTrouve
IF (CURSEC() >= Nivsec[indice]) THEN
KBDSTUFF UPPER(comm)
END
ELSE
PRINTLN "@X0FI@X0Cn@X04SUfFIsAnT @X0Fs@X0CE@X04CuRiTy @X0FL@X0Ce@X04VEl !"
WAIT
END
ENDIF
:esNtrouve
KBDSTUFF UPPER(comm)
END
;******************************************************************
;** gère la touche BACKSPACE
;******************************************************************
:bklab
ANSIPOS stacol,stalgn
PRINT statut
LET Touche = ""
LET Tmpkey = ""
ANSIPOS Keycol,Stalgn
PRINT Keycoul+Tmpkey
RETURN
;******************************************************************
;** gère les autres touches
;******************************************************************
:autrelab
Tmpkey = Tmpkey + Touche
ANSIPOS Keycol,Stalgn
PRINT ""
ANSIPOS Keycol,Stalgn
PRINT KeyCoul+Tmpkey
LET Touche = ""
FOR indice = 1 TO Max
IF (Tmpkey == Prim[indice]) GOTO Trouve
NEXT
GOTO Ntrouve
:Trouve
IF (Tablis[indice] == "") RETURN
IF (CURSEC() >= NivSec[Curind]) THEN
ANSIPOS Col[Curcol],Curlgn
PRINT Carsec+Cnor+Tablis[Curind]
ANSIPOS col[Curcol], Curlgn
PRINT Carsec+Cpri+Prim[Curind]
ELSE
ANSIPOS Col[Curcol],Curlgn
PRINT " "+Cnor+Tablis[Curind]
ANSIPOS col[Curcol], Curlgn
PRINT " "+Cpri+Prim[Curind]
ENDIF
LET Curind = indice
Curcol = ((indice+Nblgn-1)/NbLgn)
Curlgn = Minlgn +indice -1 -((Curcol-1)*Nblgn)
ANSIPOS col[Curcol], Curlgn
IF (CURSEC() >= NivSec[Curind]) THEN
PRINT Carsec+Csel+Tablis[Curind]
ANSIPOS col[Curcol], Curlgn
PRINT Carsec+Cpri+Prim[Curind]
ELSE
PRINT " "+Csel+Tablis[Curind]
ANSIPOS col[Curcol], Curlgn
PRINT " "+Cpri+Prim[Curind]
ENDIF
RETURN
:Ntrouve
ANSIPOS Col[Curcol],Curlgn
RETURN
;******************************************************************
;** affiche le menu statique
;******************************************************************
:affmenu
CLS
DISPSTR "%"+chemin+fich[3]+LANGEXT()
INPUTSTR Maincmd,comm,08h,40,MASK_ASCII(),10h
IF (UPPER(comm) == "") THEN
KBDSTUFF "^M"
END
ENDIF
TOKENIZE comm
GETTOKEN tmptok
GOSUB afflog
CLS
FOR indice = 1 TO Max
IF (UPPER(tmptok) == Prim[indice]) GOTO stTrouve
NEXT
GOTO stNtrouve
:stTrouve
IF (CURSEC() >= Nivsec[indice]) THEN
KBDSTUFF UPPER(comm)
END
ELSE
PRINTLN "@X0FI@X0Cn@X04SUfFIsAnT @X0Fs@X0CE@X04CuRiTy @X0FL@X0Ce@X04VEl !"
WAIT
END
ENDIF
:stNtrouve
KBDSTUFF UPPER(comm)
END
;******************************************************************
;** affiche le logo
;******************************************************************
:afflog
NEWLINE
ANSIPOS 32,GETY()
PRINTLN "@X0Ft@X09R@X01iLoXy @X0E≡ @X0FI@X09k@X01C/95"
DELAY 1
RETURN