MODUL WELCOM;

ORIGIN
  PARAMS   = 80H,
  params2  = 82h;

GLOBAL
  SPECFILE;

CONST
  LF      = 13;
  LITA    = 61H;
  WIDTH1  = 65;
  FNSIZE  = 14;

TYPE
  TSTR     = PACKED ARRAY [1..22]     OF CHAR;
  name     = packed array [1..FNSIZE] of char;
  chs8     = packed array [1..8] of char;
  PCHAR    = ^CHAR;
  STRST    = PACKED ARRAY [1..WIDTH1] OF CHAR;
  chS2     = PACKED ARRAY [1..2] OF CHAR;
  TBUF     = PACKED ARRAY [0..10] OF CHAR;
  FNAM     = name;
  BUFFER   = TBUF;
  PBUFFER  = ^BUFFER;
  pbyte    = ^byte;
  address  = 0..MAXINT;
  location = 0..MAXINT;

EXTERNAL VAR
  TITVER,MINTRO,MNAVOD:  CHAR;
  BE:      ADDRESS;
  BUF:     PBUFFER;
  CORLOC:  LOCATION;
  CNUMB:   INTEGER;
  CURX:    BYTE;
  CURY:    BYTE;
  GS:	   ADDRESS;
  GE: 	   ADDRESS;
  HEIGHT:  BYTE;
  EDNAME:  NAME;
  LNUMB:   INTEGER;

  MSTATLIN:STRST;
  MPRESS:  TSTR;
  mnamfe:  Tstr;
  mbadn:   tstr;
  mwait:   tSTr;
  MNEWF:   TSTR;
  mdiskro: tstr;
  NEXTROW: BYTE;

  PARAMS:  byte;
  params2: byte;
  POINT:   LOCATION;
  POSNAM:  BYTE;
  readf:   boolean;
  STATLLNG:BYTE;
$P
(* ------------------------------ MODUL FILER *)
PROCEDURE RDFILE (FN: FNAM);				EXTERNAL;

(* ------------------------------ MODUL IOCS *)
function  NAMEOKSPECF (PN: pchar; L: BYTE): boolean;	external;
procedure readname (adr: pbyte; var lng: byte);		external;
FUNCTION  EXISTSF (FN: FNAM): BOOLEAN;			EXTERNAL;
FUNCTION  DISKRO (FN: FNAM): BOOLEAN;			EXTERNAL;

(* ------------------------------ MODUL DISPMENU *)
PROCEDURE DIMSG (VAR P: PCHAR);				EXTERNAL;
procedure dispmsg (PAR: BYTE; p: pchar);		external;
function  yes: boolean;					external;

(* ------------------------------ MODUL TERMINAL *)
FUNCTION  GETCHAR: CHAR;			 EXTERNAL;
PROCEDURE CLEARSCR;				 EXTERNAL;
PROCEDURE CLEARL;				 EXTERNAL;
PROCEDURE PUTCH (CH: CHAR);			 EXTERNAL;
PROCEDURE CURDISP;				 EXTERNAL;
$p
PROCEDURE DIMX(P:PCHAR);

BEGIN
DIMSG(P);
END;


(* ==================== SPECIFIKACE VSTUPNIHO SOUBORU *)

PROCEDURE SPECFILE;
VAR I, nlng: byte;
    PARADR:  Pbyte;
    nAMHELP: fnam;
    adr:     pchar;
    LABEL    1, 9999;

dynamic procedure trick (var p: pchar);
var x: char;
begin
  p:=ref(X)-512;
end;

BEGIN
  CLEARSCR;
  DIMX (REF(TITVER));				(* "bud pozdraven!!!" *)
  CURDISP;

  PARADR:=REF(PARAMS);			(* ADR.PRIKAZ.RADKY PRI SPUSTENI *)
  NLNG  :=(PARADR^);			(* DELKA JMENA *)
  IF NLNG > 0
    THEN NLNG:=NLNG-1;
  IF (NLNG > 0) AND (NLNG < 15)
  THEN BEGIN				(* ZA "EDIt" NECO JE *)
	 PARADR:=REF(PARAMS2);
	 FOR I:=1 TO NLNG DO			(* PRESUN jmena DO EDNAME *)
	 BEGIN
	   EDNAME[I]:=CHR(PARADR^);
	   IF EDNAME[I] >= CHR(LITA)		(* PREVOD NA VELKA PISMENA *)
	     THEN EDNAME[I]:=CHR(ORD(EDNAME[I])-20H);
	   paradr:=paradr+1;
	 END;
	 IF nlng < FNSIZE 			(* DOPLN MEZERU *)
	   THEN EDNAME[I]:=' ';
	 IF NOT (NAMEOKSPECF (REF(EDNAME), NLNG))
	   THEN NLNG:=255;			(* JMENO JE SPATNE *)
         END

  ELSE BEGIN				(* spusteni beze jmena *)
	 dispmsg (33, ref(MINTRO));
	 if yes THEN
	 begin	
	   DISPMSG (35, REF(MWAIT));		(* "pockej chvilku" *)
	   BUF TYPE PCHAR:=REF(9999)+100;	(* nastav buffer pro soub.s navodem *)
	   POINT:=1;
	   GS:=1;
	   BE:=2048;
	   GE:=2048;
 	   NAMHELP:='A:EDIT.HLP ';
	   IF NOT (EXISTSF (NAMHELP))
	   THEN BEGIN
		  NAMHELP[1]:='B';
	 	  IF NOT (EXISTSF (NAMHELP))
		    THEN begin
			   dispmsg (36, ref(MNAVOD));
			   GOTO 1;	(* STRUCNY NAVOD NA DISKETE NENI !!! *)
			 end;
	        END;
	   RDFILE (NAMHELP);			(* cti soubor s navodem *)
	   clearscr;
	   curx:=1;
	   cury:=2;
	   adr :=(buf type pchar)+1;
	   while adr < ((buf type pchar)+gs) do	(* a vypis ho *)
	   begin
	     IF adr^ = chr(lf) THEN BEGIN		(* DIMSG PISE INVERZNE *)
				  CURY:=CURY+1;
				  CURX:=1;
				END
			   ELSE PUTCH (adr^);
	     adr:=adr+1;
	   end;
 	   curdisp;
 	   dispmsg (30+height-1, ref(mpress));		(* "stiskni mezeru:" *)
	   i type char:=getchar;
	   clearscr;
	   curdisp;
           end;
       END;


1:while (NLNG > 14) or (NLNG=0) do	(* nepust dal spatne jmeno !!! *)
  BEGIN
     if NLNG > 14 then
	dispmsg (36, ref(mbadn));		(* "spatne jmeno!" *)
     dispmsg (38, ref(mnamfe));			(* "jmeno editovaneho souboru:" *)
     readname (ref(EDNAME), nlng);		(* cteni jmena souboru *)
  END;

  IF DISKRO (EDNAME)			(* jmeno dobre, otestuj, zda neni r/o *)
  THEN BEGIN					(* TATO DISKETA JE R/O !!! *)	
	 dispmsg (36, ref(mdiskro));
	 NLNG:=0;
 	 GOTO 1;
       END;

  FOR I:=1 TO NLNG DO			(* NAPLNENI STAVOVE RADKY JMENEM SOUBORU *)
    MSTATLIN[I+POSNAM]:=EDNAME[I];	
  readf:=false;
  IF EXISTSF (EDNAME)			(* EXISTUJE SOUBOR NA DISKETE ? *)
  THEN begin
	 readf:=true;			(* soubor nalezen - ZAJISTI JEHO NACTENI *)
	 dispmsg (40, ref(mwait));		(* "pockej chvilku" *)
       end
  ELSE FOR I:=4 TO (HEIGHT-5) DO	(* soubor nenalezen => novy *)
	 BEGIN
	   NLNG:=I+30;
	   DISPMSG (NLNG, REF(MNEWF));		(* "novy soubor" *)
	   CURY:=I-3;
	   CLEARL;
	 END;
  buf type pchar:=ref(specfile);	(* tady bude zacatek volne pameti *)
  trick (adr);				(* dej konec volne pameti *)
  be:=adr-(buf type pchar);		(* delka bufferu *)
  if be < 0 then be:=maxint;		(* maximalne 32 kb!!! *)
  ge:=be;
  buf^[0]:=chr(lf);
  buf^[be]:=chr(lf);
  point :=1;				(* obnov, co jsi zrusil ctenim helpu *)
  GS    :=1;
  LNUMB :=1;
  cnumb :=1;
  CORLOC:=0;
9999:
END;
END.