Program Adventuregame(INPUT,OUTPUT,ADVFIL, ADVFIL2);

   (*            Stomme for aventyrspel  version 2.0

                 av Fredrik Nilsson 1988
                     numera ™hrstr”m *)

(*$IADV.INC*)

TYPE RADSTR = STRING[80];
      STR40 = STRING[40];
      STR30 = STRING[30];
      STR15 = STRING[15];
       RIKT = STRING[2];
      RIIKT = STRING[9];

CONST Rord1:Array [1..10] of RIKT =
                ('n','s','e','w','ne','nw','se','sw','u','d');

      Rord2:Array [1..10] of RIIKT =
                ('north','south','east','west','northeast'
                ,'northwest','southeast','southwest','up','down');

      Elev1:Array [0..5] of INTEGER=(37,36,45,58,68,87);
      Elev2:Array [0..5] of INTEGER=(16,17,18,19,20,21);

Var ADVFIL:TEXT;
Var ADVFIL2:FILE of CHAR;

                   (* Har kommer viktiga spel variabler *)

 Move,mmov,maxmen,score:INTEGER;
Men,gmen,gorder,forder:RADSTR;

      Kallrum:Array [1..200,1..2] of STR30;
     Tidigare:Array [1..200] of BOOLEAN;
     rumstart:Array [1..200] of REAL;
        Vagar:Array [1..200,0..11] of INTEGER;
        (* Vagar(.xxx,11.) = typ av rum
                        *)
     antalrum:INTEGER;
       Rumrad:Array [1..40] of RADSTR;

      Saknamn:Array [1..160] of STR40;
       namnII:Array [1..160] of STR40;
   antalsaker:INTEGER;
     Sakstart:Array [1..160] of REAL;
       Sakvar:Array [1..160,1..8] of INTEGER;
       Sakhit:Array [1..160] of BOOLEAN;

       (* Sakvar(.xxx,2.) = var saken finns, <0 I nagon annan sak
          Sakvar(.xxx,7.) = var saken ocks† finns!
          Sakvar(.xxx,3.) = Flagga.
                      4   = Klattrasak.
                      5   = Hur mycket den kan inneh†lla
                      6   = Hur stor den sjalv ar.
                      8   = Vilken typ av sak: 0= vanlig, 1= d”rr
                                               2= s„ck    3= b„rbar
                                               4= typ    *)

       Undrad:Array [1..100] of RADSTR;

        Opp,we,till: BYTE;
     Nyckel: Array [1..50] of BYTE;
       Open: Array [1..50] of BYTE;
                        (* = 0   „r ”ppen
                           = 1   „r st„ngd
                           = 2   „r ”ppen + l†st
                           = 3   „r st„ngd + l†st
                                *)
       Wear: Array [1..10] of BYTE;
                          (*  = 0 B„rs ej
                              = 1 B„rs p† kroppen
                              *)
   Tillstand: Array [1..10] of BYTE;
                          (*  nr till text i vilken tillst†ndet st†r
                             *)
  Specialtextstart:Array [1..40] of REAL;(* Var pa filen texten ligger*)
         antaltext:INTEGER;
           Textrad:Array [1..50] of RADSTR;

       Handnr:Array [1..20,0..3] of INTEGER;
     Handelsestart:Array [1..20] of REAL;
         Hand:INTEGER;

        Stext:Array [1..100] of RADSTR;
     snabbtex:INTEGER;

       orders:Array [1..40] of STR30;
   antalorder:BYTE;

         Ordd:Array [1..40] of STR15;

        Minne:Array [1..20] of INTEGER;   (* Kladdblock f|r    *)
         Steg:Array [1..20] of INTEGER;   (*                   *)
        Kladd:Array [1..20] of BOOLEAN;   (*    diverse.       *)

  rum,Sak,tex,ordl:INTEGER;

               ITT:RADSTR;


          lib, Hiss, moving, notegot, piled:BYTE;
          ches1, ches2, ches3, atta, pl:BYTE;


    (*    Haer kommer mer program variabler  *)

      Filnamn,OK:STRING(.11.);
p,i,t,radnr,mor:INTEGER;    (* allmanna lop variabler och dylikt *)
      filposs:REAL;
          Rad:RADSTR;
           St:CHAR;
min,sva,nuvrad:INTEGER;
    Sluta,car,carr,Skriv:BOOLEAN;
          tes:STR15;


     (*   Har kommer alla procedurer        *)


Procedure Skriv_label;

BEGIN
  Window(1,1,80,1);
  Lowvideo;
  GotoXY(1,1);
  Write('                                                                                ');
  GotoXY(1,1);Write('  ',Kallrum(.rum,2.));
  GotoXY(40,1);Write('Score: ',score);
  GotoXY(60,1);Write('Move nr: ',move);
  Normvideo;
  Window(1,2,80,25);
  GotoXY(1,24);
END;

Function Ordnr(Order:RADSTR;nr:BYTE):RADSTR;

var gp,p,mnr,le:INTEGER;
    orrd:CHAR;
    rest:RADSTR;
    sluta:BOOLEAN;

BEGIN
  mnr:=0;gp:=1;p:=1;rest:='';sluta:=False;
  le:=Length(Order);
  IF Copy(Order,le,1)<>' ' THEN Order:=Order+' ';
  le:=Length(Order);
  REPEAT
    orrd:=Copy(Order,p,1);
    IF Ord(orrd)=32 THEN
    BEGIN
      mnr:=mnr+1;
      IF mnr=nr THEN sluta:=TRUE;
      rest:=Copy(Order,gp,p-gp);
      gp:=p+1;
    END;
    p:=p+1;
  UNTIL (sluta) or (p>le);
  IF mnr=nr THEN Ordnr:=rest ELSE Ordnr:='';
END;

Function Varlen(variabel:INTEGER):REAL;

var s:STR15;
    l:INTEGER;
    svar:REAL;

BEGIN
  Str(variabel, s);
  l:=length(s);
  svar:=l;
  Varlen:=svar;
END;

Procedure Rumlas;

BEGIN
  FOR i:=1 TO 10 DO
  BEGIN
    Read(ADVFIL,Vagar(.rum,i.));
    filposs:=filposs+Varlen(Vagar(.rum,i.))+1;
  END;
  Readln(ADVFIL,Vagar(.rum,11.)); filposs:=filposs+Varlen(Vagar(.rum,11.))+2;
  Readln(ADVFIL,Kallrum(.rum,1.)); filposs:=filposs+length(Kallrum(.rum,1.))+2;
  Readln(ADVFIL,Kallrum(.rum,2.)); filposs:=filposs+length(Kallrum(.rum,2.))+2;
  radnr:=radnr+3;
  Vagar(.rum,0.):=radnr;
  Rumstart(.rum.):=filposs;
  REPEAT
    Readln(ADVFIL,Rad);
    filposs:=filposs+length(Rad)+2;
    radnr:=radnr+1;
  UNTIL (Copy(Rad,1,1)='#') or (EOF(ADVFIL));
  rum:=rum+1;
END;


Procedure Saklas;

BEGIN
  Readln(ADVFIL,Saknamn(.Sak.)); filposs:=filposs+length(Saknamn(.Sak.))+2;
  Readln(ADVFIL,namnII(.Sak.)); filposs:=filposs+length(namnII(.Sak.))+2;

  Read(ADVFIL,Sakvar(.Sak,2.)); filposs:=filposs+Varlen(Sakvar(.Sak,2.))+1;
  Read(ADVFIL,Sakvar(.Sak,7.)); filposs:=filposs+Varlen(Sakvar(.Sak,7.))+1;
  Read(ADVFIL,Sakvar(.Sak,3.)); filposs:=filposs+Varlen(Sakvar(.Sak,3.))+1;
  Read(ADVFIL,Sakvar(.Sak,4.)); filposs:=filposs+Varlen(Sakvar(.Sak,4.))+1;
  Read(ADVFIL,Sakvar(.Sak,5.)); filposs:=filposs+Varlen(Sakvar(.Sak,5.))+1;
  Read(ADVFIL,Sakvar(.Sak,6.)); filposs:=filposs+Varlen(Sakvar(.Sak,6.))+1;
  Readln(ADVFIL,Sakvar(.Sak,8.)); filposs:=filposs+Varlen(Sakvar(.Sak,8.))+2;

  radnr:=radnr+3;
  case (Sakvar[Sak,8]) of
    0 : BEGIN END;
    1 :
  BEGIN
    Readln(ADVFIL,Open(.Opp.),Nyckel(.Opp.));
    filposs:=filposs+Varlen(Open(.Opp.))+Varlen(Nyckel(.Opp.))+3;
    Opp:=opp+1;
    radnr:=radnr+1;
  END;
    2 :
  BEGIN
    Readln(ADVFIL,Open(.Opp.),Nyckel(.Opp.));
    filposs:=filposs+Varlen(Open(.Opp.))+Varlen(Nyckel(.Opp.))+3;
    Opp:=opp+1;
    radnr:=radnr+1;
  END;
     3 :
  BEGIN
    Readln(ADVFIL,wear[we]);
    filposs:=filposs+Varlen(Wear[we])+2;
    we:=succ(we);
    radnr:=succ(radnr);
  END;
     4 :
  BEGIN
    Readln(ADVFIL,tillstand[till]);
    filposs:=filposs+Varlen(tillstand[till])+2;
    till:=succ(till);
    radnr:=succ(radnr);
  END;
  END; (*case*)
  Sakvar(.sak,1.):=radnr;
  Sakstart(.sak.):=filposs;
  REPEAT
    Readln(ADVFIL,Rad);
    filposs:=filposs+length(Rad)+2;
    radnr:=radnr+1;
  UNTIL (Copy(Rad,1,1)='#') or (EOF(ADVFIL));
  Sak:=Sak+1;
END;


Procedure Textlas;

BEGIN
  Readln(ADVFIL,Rad); radnr:=radnr+1; filposs:=filposs+length(Rad)+2;
  Specialtextstart(.tex.):=filposs;
  REPEAT
    Readln(ADVFIL,Rad);
    filposs:=filposs+length(Rad)+2;
    radnr:=radnr+1;
  UNTIL (Copy(Rad,1,1)='#') or (EOF(ADVFIL));
  tex:=tex+1;
END;


Procedure Orderlas;

var sluta:BOOLEAN;

BEGIN
  sluta:=False;
  REPEAT
    Readln(ADVFIL,Orders(.antalorder.));
    filposs:=filposs+length(Orders(.antalorder.))+2;
    IF Copy(Orders(.antalorder.),1,1)='#' THEN sluta:=True;
    Orders(.antalorder.):=Orders(.antalorder.)+' ';
    antalorder:=antalorder+1;radnr:=radnr+1;
  UNTIL (sluta) or (Eof(ADVFIL));
  antalorder:=antalorder-1;
END;


Procedure Snabbtextlas;

BEGIN
  REPEAT
    Readln(ADVFIL,Stext(.snabbtex.));
    filposs:=filposs+length(Stext(.snabbtex.))+2;
    radnr:=radnr+1;
    snabbtex:=snabbtex+1;
  UNTIL Copy(Stext(.snabbtex-1.),1,1)='#';
  snabbtex:=snabbtex-1;
END;


Procedure Handelselas;

BEGIN
  Readln(ADVFIL,Handnr(.hand,1.),Handnr(.hand,2.));
  filposs:=filposs+Varlen(Handnr(.hand,1.))+Varlen(Handnr(.hand,2.))+3;
  radnr:=radnr+1;
  Handelsestart(.hand.):=filposs;
  Handnr(.hand,0.):=radnr;hand:=hand+1;
  REPEAT
    Readln(ADVFIL,Rad);
    filposs:=filposs+length(Rad)+2;
    radnr:=radnr+1;
  UNTIL (Copy(Rad,1,1)='#') or (Eof(ADVFIL));
END;


Procedure Ordlistalas;

var steg:INTEGER;

BEGIN
  REPEAT
    Readln(ADVFIL,Rad); filposs:=filposs+length(Rad)+2;
    Rad:=Rad+' ';
    radnr:=radnr+1;steg:=1;
    REPEAT
      IF Ordnr(Rad,steg)<>'' THEN
      BEGIN Ordd(.ordl.):=Ordnr(Rad,steg);ordl:=ordl+1;steg:=steg+1;END;
    UNTIL Ordnr(Rad,steg)='';
  UNTIL Copy(Rad,1,1)='#';
  ordl:=ordl-1;
END;


Function Readrad:RADSTR;

var Rad:RADSTR;
     ch:CHAR;

BEGIN
  Rad:='';
  REPEAT
    Read(ADVFIL2,ch);
    IF Ord(ch)<>13 THEN Rad:=Rad+ch;
  UNTIL (Ord(ch)=13) or (Eof(ADVFIL2));
  Read(ADVFIL2,ch);
  Readrad:=Rad;
END;


Procedure Filinit;

var St:CHAR;

BEGIN
  Assign(ADVFIL,Filnamn);
  Reset(ADVFIL);

  rum:=1;   sak:=1;
  tex:=1;   antalorder:=1;
  radnr:=1; snabbtex:=1;
  hand:=1;  ordl:=1;
  Opp:=1;   filposs:=0;
  we:=1;    till:=1;
  WHILE NOT Eof(ADVFIL) DO
  BEGIN
    Read(ADVFIL,St);
    filposs:=filposs+1;
    Case St of
      '!' : Rumlas;
      '$' : Saklas;
      '&' : Textlas;
      '=' : Orderlas;
      '?' : Snabbtextlas;
      '^' : Handelselas;
      '>' : Ordlistalas;
    END;    (* case *)
  END;    (* WHILE *)
    antalrum:=rum-1;
  antalsaker:=Sak-1;
   antaltext:=tex-1;
    snabbtex:=snabbtex-1;
        hand:=hand-1;
  antalorder:=antalorder-1;
         Opp:=Opp-1;
         we:=we-1;
       till:=till-1;
  close(ADVFIL);
  writeln('DEBUG> rum=',antalrum, ' saker=',antalsaker);
END;  (*   Filinit    *)


Procedure More;

BEGIN
  mor:=mor+1;
  IF mor>21 THEN
  BEGIN
    GotoXY(1,24);Lowvideo;
    Write('**MORE**');mor:=0;
    Normvideo;
    REPEAT UNTIL Keypressed;
    GotoXY(1,24);
    Write('         ');
    GotoXY(1,24);
  END;
END;


Procedure Filfinn(nyposs:REAL);

BEGIN
  Longseek(ADVFIL2, nyposs);
END;


Function Ord_grupp(Order:RADSTR;st,sl:BYTE):RADSTR;

var i:BYTE;
    ut:RADSTR;

BEGIN
  ut:='';
  FOR i:=st TO sl DO
  ut:=ut+Ordnr(Order,i)+' ';
  Delete(ut,Length(ut),1);
  Ord_grupp:=ut;
END;

Procedure Stega(nr,max:INTEGER);

BEGIN
  Steg(.nr.):=Steg(.nr.)+1;
  IF Steg(.nr.)>max THEN Steg(.nr.):=1;
END;

Procedure Hande2(va:INTEGER);FORWARD;

Function Antal_ord(Order:RADSTR):BYTE;FORWARD;

Procedure Skrivrad(Rad:RADSTR);

var s1,s2,s3,s4,s5,s6:INTEGER;

BEGIN
  IF (skriv=True) and (Copy(Rad,1,1)='\') THEN
  BEGIN
    Rad:=Rad+' ';
    Val(Ordnr(Rad,2),s1,p);
    Hande2(s1);
  END
  ELSE
  IF (Skriv=True) and (Copy(Rad,1,1)='/') THEN
  BEGIN
    Rad:=Rad+' ';Skriv:=False;
    Case Copy(Rad,2,1) of
      'T' : BEGIN Val(Ordnr(Rad,2),s1,p);
                  Val(Ordnr(Rad,3),s2,p);
                  IF (move>s1) and (move<s2) THEN Skriv:=True;
            END;
      'S' : BEGIN Val(Ordnr(Rad,2),s1,p);
                  Val(Ordnr(Rad,3),s2,p);
                  Val(Ordnr(Rad,4),s3,p);
                  IF Sakvar(.s1,s2.)=s3 THEN Skriv:=True;
            END;
      'M' : BEGIN Val(Ordnr(Rad,2),s1,p);
                  Val(Ordnr(Rad,3),s2,p);
                  IF minne(.s1.)=s2 THEN Skriv:=True;
            END;
      'P' : BEGIN Val(Ordnr(Rad,2),s1,p); DELAY(s1*1000);
                  Skriv:=True;
            END;
    END;
  END
  ELSE IF Copy(Rad,1,2)='/#' THEN Skriv:=True
  ELSE IF Skriv THEN BEGIN Writeln(Rad);More; END;
END;


Procedure Skrivtext(nr:INTEGER);

var Rad:RADSTR;
    i:INTEGER;

BEGIN
  Rad:='';
  IF Minne(.1.)<>nr THEN
  BEGIN
    Minne(.4.):=1;
    Filfinn(Specialtextstart(.nr.));
    REPEAT
      Rad:=Readrad;nuvrad:=nuvrad+1;
      IF Copy(Rad,1,1)<>'#' THEN
      BEGIN
        Textrad(.Minne(.4.).):=Rad;
        Minne(.4.):=Minne(.4.)+1;
      END;
    UNTIL (Copy(Rad,1,1)='#') or (EOF(ADVFIL));
    Minne(.4.):=Minne(.4.)-1;Minne(.1.):=nr;
  END;
  FOR i:=1 TO Minne(.4.) DO Skrivrad(Textrad(.i.));
END;



Procedure Skrivrum(nr:INTEGER);

var Rad:RADSTR;
    i:INTEGER;

BEGIN
  rad:='';
  Writeln(Kallrum(.nr,1.),' ',Kallrum(.nr,2.),'.');More;
  IF Minne(.2.)<>nr THEN
  BEGIN
    Minne(.5.):=1;
    Filfinn(Rumstart(.nr.));
    REPEAT
      Rad:=Readrad;nuvrad:=nuvrad+1;
      IF Copy(Rad,1,1)<>'#' THEN
      BEGIN
        Rumrad(.Minne(.5.).):=Rad;
        Minne(.5.):=Minne(.5.)+1;
      END;
    UNTIL (Copy(Rad,1,1)='#') or (EOF(ADVFIL));
    Minne(.5.):=Minne(.5.)-1;Minne(.2.):=nr;
  END;
  IF Rumrad(.1.)<>'/X' THEN FOR i:=1 TO Minne(.5.) DO Skrivrad(Rumrad(.i.))
  ELSE BEGIN Val(Rumrad(.2.),i,p);Skrivtext(i);END;
END;  (* Skrivrumin *)


Procedure Skrivstext(nr:INTEGER;namn:STR40);

var snt:RADSTR;
      p:BYTE;

BEGIN
  p:=pos('=',stext(.nr.));
  snt:=stext(.nr.);
  IF p>0 THEN
  BEGIN
    Delete(snt,p,1);
    Insert(namn,snt,p);
  END;
  Writeln(snt);More;
END;


Procedure SkrivHandelse(nr:INTEGER);

BEGIN
  Filfinn(Handelsestart(.nr.));
  REPEAT
    Rad:=Readrad;nuvrad:=nuvrad+1;
    IF Copy(Rad,1,1)<>'#' THEN Skrivrad(Rad);
  UNTIL (Copy(Rad,1,1)='#') or (Eof(ADVFIL));
END;


Procedure Skrivsak(nr:INTEGER;prep:STR15);

var i,st,sl,min,sva,p:INTEGER;
        hit:BOOLEAN;
        namn:STR40;

BEGIN
  IF Minne(.3.)<>nr THEN
  BEGIN
    Minne(.3.):=nr;
    Minne(.6.):=0;
    Filfinn(Sakstart(.nr.));
    REPEAT
      Minne(.6.):=Minne(.6.)+1;
      Rad:=Readrad;nuvrad:=nuvrad+1;
      Undrad(.Minne(.6.).):=Rad;
    UNTIL (Copy(Rad,1,1)='#') or (Eof(ADVFIL));
    Minne(.6.):=Minne(.6.)-1;
  END;
  IF Minne(.6.)=0 THEN
  BEGIN
    Stega(10,3);
    SkrivsText(50+Steg(.10.),Ord_grupp(Saknamn(.nr.),2,Antal_ord(Saknamn(.nr.))));
  END
  ELSE
 BEGIN
  i:=1; (* Rutin f|r att hitta start och slut p} unders|kningsdel*)
  st:=0;sl:=0;hit:=False;
  REPEAT
    IF Copy(Undrad(.i.),1,2)='% ' THEN
    BEGIN
      Val(Ordnr(Undrad(.i.),2),min,p);
      IF Ordd(.min.)=Prep THEN BEGIN st:=i+1;hit:=True;END;
    END;
    IF (Copy(Undrad(.i.),1,2)='%#') and (hit) THEN sl:=i-1;
    i:=i+1;
  UNTIL (sl<>0) or (i=Minne(.6.)+1);
  IF sl<>0 THEN FOR i:=st TO sl DO Skrivrad(Undrad(.i.))
  ELSE
  BEGIN
    Stega(10,3);
    SkrivsText(36+Steg(.10.),prep+' the '+Ord_grupp(Saknamn(.nr.),2,Antal_ord(Saknamn(.nr.))));
  END;
 END;
END;

Procedure Itta(nr:INTEGER);

BEGIN
  ITT:=Ord_grupp(Saknamn(.nr.),2,Antal_ord(Saknamn(.nr.)));
END;

Function S_nam(i:INTEGER):RADSTR;

BEGIN
  S_nam:=Ord_grupp(Saknamn(.i.),2,Antal_ord(Saknamn(.i.)));
END;

Function Kolla_men(Order:RADSTR;antal:BYTE):BOOLEAN;

var svar:BOOLEAN;

BEGIN
  Order:=Order+' ';
  IF Antal_ord(Order)<antal THEN
  BEGIN
    svar:=False;
    SkrivStext(46,'');
  END
  ELSE Svar:=True;
  Kolla_men:=svar;
END;


Procedure Init;

var i:INTEGER;

BEGIN
  Normvideo;
  ClrScr;
  Window(1,2,80,25);
  Filnamn:='BADMAR.DAT';
  forder:='';
  gorder:='';
  OK:='OK.';
  score:=0;
  antalrum:=0;
  antalsaker:=0;
  antaltext:=0;
  hand:=0;
  mor:=0;
  move:=1;
  Sluta:=False;
  nuvrad:=10000;
  mmov:=10;
  Skriv:=True;
  GotoXY(1,24);
  FOR i:=1 TO 100 DO Sakhit(.i.):=False;
  FOR i:=1 TO 200 DO Tidigare(.i.):=False;
  FOR i:=1 TO 20 DO
  BEGIN
    Minne(.i.):=0;
    Kladd(.i.):=False;
    Steg(.i.):=1;
  END;
  Hiss:=4;
  moving:=0;
  piled:=0;
  notegot:=0;
  Open[8]:=0;
  lib:=0;
  ches1:=0;
  ches2:=0;
  ches3:=0;
  atta:=0;
  pl:=0;
END;

Function Lowcase_order(Order:RADSTR):RADSTR;FORWARD;

Procedure Renshit;

var i:INTEGER;

BEGIN
  FOR i:=1 to antalsaker DO Sakhit(.i.):=False;
END;


Function Hitta_sak(rum:INTEGER):INTEGER;

var antal,i:INTEGER;

BEGIN
  antal:=0;
  FOR i:=1 to antalsaker DO
    IF (Sakvar(.i,2.)=rum) or (Sakvar(.i,7.)=rum) THEN
    BEGIN antal:=antal+1;Sakhit(.i.):=True;END;
  Hitta_sak:=antal;
END;

Function Hitta_namn(namn:STR40):INTEGER;

var i,sok,antal:INTEGER;
    nam:RADSTR;

BEGIN
  antal:=0;
  FOR i:=1 TO antalsaker DO
  IF Sakhit(.i.) THEN
  BEGIN
    nam:=Saknamn(.i.)+' '+namnII(.i.)+' ';
    IF Ordnr(nam,1)='a' THEN Delete(nam,1,2);
    IF Ordnr(nam,1)='an' THEN Delete(nam,1,3);
    nam:=Lowcase_order(nam);
    sok:=1;Sakhit(.i.):=False;
    REPEAT
      IF Ordnr(nam,sok)=namn THEN
      BEGIN
        Sakhit(.i.):=True;
        antal:=antal+1;
      END
      ELSE sok:=sok+1;
    UNTIL (Ordnr(nam,sok)='') or (Sakhit(.i.));
  END;
  Hitta_namn:=antal;
END;



Function Hitta_pryl(namn:RADSTR):INTEGER;

Label Return;

var h,i,t,ant:INTEGER;

BEGIN
  h:=0;Renshit;ant:=Antal_ord(namn);
  i:=Hitta_sak(rum);
  t:=Hitta_sak(-1);
  IF (i=0) and (t=0) THEN Goto Return;
  FOR i:=1 TO ant DO t:=Hitta_namn(Ordnr(namn,i));
  FOR i:=1 TO antalsaker DO IF Sakhit(.i.) THEN h:=h+1;
  Return:
  Hitta_pryl:=h;
END;


Function Hitta_hit:INTEGER;

var i:INTEGER;

BEGIN
  FOR i:=1 TO antalsaker DO IF Sakhit(.i.) THEN Hitta_hit:=i;
END;


Function Sak_koll(Order:RADSTR):INTEGER;

var i:INTEGER;

BEGIN
  Order:=Ord_grupp(Order,2,Antal_ord(Order));
  i:=Hitta_pryl(Order);
  IF i>1 THEN Skrivstext(27,order);
  IF i=0 THEN Skrivstext(28,order);
  IF i=1 THEN i:=Hitta_hit ELSE i:=0;
  Sak_koll:=i;
END;

Function Sak_nr(Order:RADSTR):INTEGER;

var i,h,ant:INTEGER;

BEGIN
  ant:=Antal_ord(Order); h:=0;
  FOR i:=1 to antalsaker DO Sakhit(.i.):=TRUE;

  FOR i:=2 TO ant DO t:=Hitta_namn(Ordnr(Order,i));
  FOR i:=1 TO antalsaker DO IF Sakhit(.i.) THEN h:=h+1;

  IF h=1 THEN i:=Hitta_hit ELSE i:=0;
  Sak_nr:=i;
END;


Function Order:RADSTR;

var Rad:RADSTR;

BEGIN
  IF (Move<mmov) and (carr) THEN Skrivstext(Steg(.1.),'') ELSE Writeln;
  Stega(1,5);More;
  mor:=0;
  REPEAT
    Skriv_label;
    Write('>');
    Readln(Con,Rad);
    IF Rad='' THEN
    BEGIN
      Skrivstext(5+Steg(.2.),'');
      Stega(2,5);
    END;
  UNTIL Rad<>'';
  Order:=Rad;
  carr:=True;
END;


Function Locase(ch:CHAR):CHAR;

BEGIN
  IF ch IN (.'A'..']'.) THEN
    Locase:=Chr(Ord(ch)+32)
  ELSE Locase:=ch;
END;


Function Upcase_Order(Order:RADSTR):RADSTR;

var i:BYTE;
    Uo:RADSTR;

BEGIN
  Uo:='';
  FOR i:=1 TO Length(Order) DO
  Uo:=Concat(Uo,Upcase(Copy(Order,i,1)));
  Upcase_Order:=Uo;
END;


Function Lowcase_Order;

var i:BYTE;
    Uo:RADSTR;

BEGIN
  Uo:='';
  FOR i:=1 TO Length(Order) DO
  Uo:=Concat(Uo,Locase(Copy(Order,i,1)));
  Lowcase_Order:=Uo;
END;


Function Snygg_order(Order:RADSTR):RADSTR;

var i,le:INTEGER;
    gc,nc:STRING(.1.);

BEGIN
  REPEAT
    le:=Length(Order);
    IF Copy(Order,1,1)=' ' THEN Delete(Order,1,1);
  UNTIL Copy(Order,1,1)<>' ';
  gc:='q';nc:='q';
  FOR i:=1 TO le DO
  BEGIN
    nc:=Copy(Order,i,1);
    IF (gc=nc) and (nc=' ') THEN
    BEGIN Delete(Order,i,1);i:=i-1;le:=Length(order);END;
    gc:=nc;
  END;
  IF Copy(Order,le,1)<>' ' THEN Order:=Concat(Order,' ');
  Snygg_order:=Order;
END;

(* Funktionen finnopp1 returnerar den egentliga saksiffran p†
   d”rrtypen man testar. *)

Function Finnopp1(nr,ex:INTEGER):INTEGER;

var i,nn:INTEGER;
label RETURN;

BEGIN
  nn:=0;
  FOR i:=1 TO antalsaker DO
  IF Sakvar(.i,8.)=ex THEN
  BEGIN
    nn:=nn+1;
    IF nn=nr THEN GOTO RETURN;
  END;
RETURN:
  IF nn=nr THEN FinnOpp1:=i ELSE FinnOpp1:=0;
END;

(* Finnopp2 returnerar d”rrsiffran f”r en viss sak. *)

Function FinnOpp2(nr,ex:INTEGER):INTEGER;

var i,nn:INTEGER;

BEGIN
 nn:=0;
 IF Sakvar(.nr,8.)=ex THEN FOR i:=1 TO nr DO IF Sakvar(.i,8.)=ex THEN nn:=nn+1;
 IF nn>0 THEN FinnOpp2:=nn ELSE FinnOpp2:=0;
END;



Procedure Inventory;

var i,na:INTEGER;

BEGIN
  Writeln('You are carrying:');
  na:=Hitta_sak(-1);
  IF na>0 THEN FOR i:=1 TO antalsaker DO
  BEGIN
    IF Sakvar(.i,2.)=-1 THEN
    BEGIN
      Write(Saknamn(.i.));
      IF Sakvar(.i,8.)=3 THEN IF wear(.Finnopp2(i,3).)=1 THEN Write(' which you are wearing');
      IF Sakvar(.i,8.)=2 THEN
      IF (open(.Finnopp2(i,2).)=1) or (open(.Finnopp2(i,2).)=3) THEN
      BEGIN
        Writeln(' which is open and contains:');
        FOR na:=1 TO antalsaker DO
        IF Sakvar(.na,2.)=-i THEN Writeln('        ',Saknamn(.na.));
      END;
      Writeln('');
    END;
  END
  ELSE Writeln('nothing!');
END;


Procedure Get(Order:RADSTR);

Label Return;
var i,sak:INTEGER;

BEGIN
  IF Kolla_men(Order,2) THEN
 BEGIN
  sak:=Sak_koll(Order);
  IF sak>0 THEN
  BEGIN
    Itta(sak);
    IF Sakvar(.sak,2.)=-1 THEN BEGIN Skrivstext(29,'');Goto Return;END;
    IF Sakvar(.sak,3.)=1 THEN BEGIN SkrivStext(30,'');Goto Return;END;
    IF Sakvar(.sak,3.)>1 THEN BEGIN Skrivtext(Sakvar(.sak,3.));Goto Return;END;
    IF Sakvar(.sak,3.)=0 THEN
    BEGIN
      Skrivstext(31,Order);
      Sakvar(.sak,2.):=-1;
      Sakvar(.sak,7.):=-1;
    END;
  END;
  Return:
 END;
END;



Procedure Drop(Order:RADSTR);

Label Return;
var i,sak:INTEGER;

BEGIN
  IF Kolla_men(Order,2) THEN
 BEGIN
  sak:=Sak_koll(Order);
  IF sak>0 THEN
  BEGIN
    Itta(sak);
    IF Sakvar(.sak,2.)<>-1 THEN BEGIN Skrivstext(32,'');Goto Return;END;
    IF Sakvar(.sak,3.)=1 THEN BEGIN SkrivStext(33,'');Goto Return;END;
    IF Sakvar(.sak,3.)>1 THEN BEGIN Skrivtext(Sakvar(.sak,3.));Goto Return;END;
    IF Sakvar(.sak,3.)=0 THEN
    BEGIN
      Skrivstext(34,Order);
      Sakvar(.sak,2.):=rum;
      Sakvar(.sak,7.):=rum;
      IF Sakvar(.sak,8.)=3 THEN Wear(.Finnopp2(sak,3).):=0;
    END;
  END;
  Return:
 END;
END;

Function Finnrikt(Ordd:RIIKT):INTEGER;

var i:BYTE;

BEGIN
  i:=0;
  REPEAT
    i:=i+1;
  UNTIL (Ordd=Rord1(.i.)) or (Ordd=Rord2(.i.)) or (i>10);
  IF i<11 THEN Finnrikt:=i ELSE Finnrikt:=0;
END;

Function Finnprep(Prep:RADSTR):BOOLEAN;

var i:BYTE;
    p:BOOLEAN;

BEGIN
  p:=False;
  FOR i:=1 TO ordl DO IF Prep=Ordd(.i.) THEN p:=True;
  Finnprep:=p;
END;

Function Hittaprep(Text:RADSTR; p:INTEGER):INTEGER;

var ant,i,po:BYTE;

BEGIN
  ant:=Antal_ord(Text); po:=0;
  FOR i:=1 TO ant DO IF Ordd(.p.)=Ordnr(Text, i) THEN po:=i;
  Hittaprep:=po;
END;

Procedure Ga_rum(rum,ov:INTEGER);FORWARD;


Procedure Walk(Order:RADSTR);

var vag,vvv,i,nr:INTEGER;
     Orl:RADSTR;

BEGIN
  IF Kolla_men(Order,2) THEN
 BEGIN
  vag:=Finnrikt(Ordnr(Order,2));
  IF vag>0 THEN
  BEGIN
    IF (vagar(.rum,vag.)>0) and (vagar(.rum,vag.)<1000) THEN
    BEGIN
      rum:=vagar(.rum,vag.);
      IF Move<mmov THEN BEGIN writeln(OK);More;END;
      Ga_rum(rum,mmov);
    END
    ELSE
    IF vagar(.rum,vag.)>=1000 THEN
    BEGIN
    case vagar(.rum,vag.) of
      1000 : BEGIN writeln('A big fence blocks your way.'); More; END;
      1001 : BEGIN writeln('You may not have noticed, but there is a school there.');More;END;
      1002 : BEGIN writeln('Good luck, I didn''t know you could fly!');More;END;
      1003 : BEGIN writeln('The ground won''t permit you.'); More;END;
      1004 : BEGIN writeln('Something is in the way, but you push it aside and creep through a small hole.');
                   writeln('Eventually you come out behind a painting in a small, quite empty room.');
                   rum:=121; Ga_rum(rum,mmov);
             END;
      1006 : BEGIN writeln('You strawl north and suddenly you fall down into a basin.');
                   rum:=166; Ga_rum(rum, mmov);
             END;
      1007 : BEGIN writeln('You walk south and suddenly you fall down into a basin.');
                   rum:=166; Ga_rum(rum, mmov);
             END;
      1008 : BEGIN writeln('You climb out of the basin and eventually reach the top.');
                   rum:=165; Ga_rum(rum, mmov);
             END;
      1009 : BEGIN writeln('You climb out of the basin and eventually reach the top.');
                   rum:=167; Ga_rum(rum, mmov);
             END;
      1010 : BEGIN writeln('Evidently the cleaner is not in mood to let you pass.');
                   More;
                   writeln('He seems to miss some vital tool for the completion of');
                   More;
                   writeln('his work.');
                   More;
             END;
    END;
    END
    ELSE
    IF vagar(.rum,vag.)<0 THEN
    BEGIN
      vvv:=-vagar(.rum,vag.);
      nr:=FinnOpp1(vvv,1);
      IF (Open(.vvv.)=1) or (Open(.vvv.)=3) THEN
      BEGIN
      Orl:=Saknamn(.nr.)+' ';
      Skrivstext(40,Ord_grupp(Orl,2,Antal_ord(Orl)));More;
      END
      ELSE
      BEGIN
        IF rum=Sakvar(.nr,2.) THEN rum:=Sakvar(.nr,7.)
        ELSE IF rum=Sakvar(.nr,7.) THEN rum:=Sakvar(.nr,2.);
        IF Move<mmov THEN BEGIN writeln(OK);More;END;
        Ga_rum(rum,mmov);
      END;
    END
    ELSE
    BEGIN
      Skrivstext(15+Steg(.4.),'');Stega(4,5);More;
    END;
  END
  ELSE
  BEGIN
    Orl:=Ord_grupp(Order,2,maxmen);
    vag:=Hitta_pryl(Orl);
    IF vag>1 THEN Skrivstext(27,Orl);
    IF vag=0 THEN BEGIN Skrivstext(20+Steg(.5.),Orl);Stega(5,2);More; END;
    IF vag=1 THEN
    BEGIN
      vag:=Hitta_hit;
      IF Sakvar(.vag,4.)>0 THEN
      BEGIN
        rum:=Sakvar(.vag,4.);
        IF Move<mmov THEN BEGIN Writeln(OK);More;END;
        Ga_rum(rum,mmov);
        Itta(vag);
      END
      ELSE
      BEGIN Skrivstext(36,'');More;END;
    END;
  END;
 END;
END;


Procedure Ga_rum;

var i,na:INTEGER;
    flagga:BOOLEAN;

BEGIN
  IF (ov=0) or (Tidigare(.rum.)=False) THEN
  BEGIN
    Tidigare(.rum.):=True;
    Skrivrum(rum);
  END
  ELSE Writeln('(',Kallrum(.rum,2.),')');More;
  Flagga:=True;na:=0;
  na:=Hitta_sak(rum);
  FOR i:=1 TO antalsaker DO
  IF (Sakvar[i,8]=1) and ((Sakvar[i,7]=rum) or (Sakvar[i,2]=rum)) THEN
    IF Open[Finnopp2(i,1)]=0 THEN Writeln('The ',S_nam(i),' is open.');

  FOR i:=1 TO antalsaker DO
  IF (Sakvar(.i,2.)=rum) and (Sakvar(.i,8.)=4) THEN
  BEGIN
    Write(S_nam(i));
    case tillstand[finnopp2(i, 4)] of
      0 : Writeln(' is here.');
      1 : Writeln(' is here looking bored.');
      2 : Writeln(' is here playing the violin.');
      3 : Writeln(' is here playing the piano.');
      4 : Writeln(' is here sleeping. (He snors loudly.)');
      5 : Writeln(' is here playing chess.');
    END;
  END;

  FOR i:=1 TO antalsaker DO
  BEGIN
    IF (Sakvar(.i,2.)=rum) and (Sakvar(.i,3.)=0) THEN
    BEGIN
      na:=na-1;
      IF Flagga THEN
      BEGIN
        Flagga:=False;
        Stega(8,3);
        Case Steg(.8.) of
         1,3 : Write(Stext(.25.),' ');
           2 : Write(Stext(.26.),' ');
        END;
      END
      ELSE
      BEGIN
        IF na=1 THEN Write(' ',Ordd(.18.),' ');
        IF na>1 THEN Write(', ');
      END;
      Write(Saknamn(.i.));
    END;
  END;
  IF not Flagga THEN
  Case Steg(.8.) of
   1,3 : Writeln(' ',Ordd(.20.),'.');
     2 : Writeln('.');
  END;
END;  (* ga_rum  = ga_rum *)


Function Hitta_order(Order:STR30):BYTE;

Label RETURN;
var i,t:BYTE;
    funnen:BOOLEAN;

BEGIN
  Funnen:=False;
  FOR i:=1 TO antalorder DO
  BEGIN
    t:=0;
    REPEAT
      t:=t+1;
      IF Order=Ordnr(Orders(.i.),t) THEN BEGIN Funnen:=True;Goto RETURN;END;
    UNTIL (Ordnr(Orders(.i.),t)='');
  END;
  RETURN:
  IF Funnen THEN Hitta_Order:=i
  ELSE Hitta_order:=0;
END;


Procedure Look(Order:RADSTR);

var i,sak:INTEGER;
      Orr:RADSTR;

BEGIN
  IF (Ordnr(Order,2)='') or (Ordnr(Order,2)=Ordd(.4.)) THEN
  BEGIN
    Ga_rum(rum,0);
  END
  ELSE
  BEGIN
    IF (Finnprep(Ordnr(Order,2))) and (maxmen>2) THEN
    BEGIN
      Orr:=Ord_grupp(Order,3,maxmen);
      i:=Hitta_pryl(Orr);
      IF i>1 THEN SkrivStext(27,Orr);
      IF i=0 THEN SkrivStext(28,Orr);
      IF i=1 THEN
      BEGIN
        sak:=Hitta_hit;
        Skrivsak(sak,Ordnr(Order,2));
        Itta(sak);
      END;
    END ELSE Skrivstext(35,'');
  END;
END;


Function Antal_ord;

var i:BYTE;

BEGIN
  i:=0;
  REPEAT
    i:=i+1;
  UNTIL Ordnr(Order,i)='';
  Antal_ord:=i-1;
END;


Procedure Examine(Order:RADSTR);

BEGIN
  Order:='look at '+Ord_grupp(Order,2,Antal_ord(Order))+' ';
  maxmen:=Antal_ord(Order);
  Look(Order);
END;

Procedure Oppna(order:RADSTR);

var i,t,nr:INTEGER;

BEGIN
  IF Kolla_men(Order,2) THEN
 BEGIN
  i:=Sak_koll(Order);
  IF i>0 THEN
  BEGIN
    Itta(i);
    nr:=FinnOpp2(i,1);
    IF nr<>0 THEN
    BEGIN
      IF (Open(.nr.)=0) or (Open(.nr.)=2) THEN Skrivstext(41,S_nam(i))
      ELSE
      IF Open(.nr.)=3 THEN Skrivstext(43,S_nam(i))
      ELSE
      BEGIN
        Open(.nr.):=0;
        Writeln(OK);More;
      END;
    END ELSE SkrivStext(49,'');
  END;
 END;
END;

Procedure Stang(order:RADSTR);

var i,t,nr:INTEGER;

BEGIN
  IF Kolla_men(Order,2) THEN
 BEGIN
  i:=Sak_koll(Order);
  IF i>0 THEN
  BEGIN
    Itta(i);
    nr:=FinnOpp2(i,1);
    IF nr<>0 THEN
    BEGIN
      IF (Open(.nr.)=1) or (Open(.nr.)=3) THEN Skrivstext(42,S_nam(i))
      ELSE
      IF Open(.nr.)=2 THEN Skrivstext(43,S_nam(i))
      ELSE
      BEGIN
        Open(.nr.):=1;
        Writeln(OK);More;
      END;
    END ELSE SkrivStext(50,'');
  END;
 END;
END;

Procedure losa(Order:RADSTR);

var i,nr,nyck:INTEGER;

BEGIN
  IF Kolla_men(Order,2) THEN
 BEGIN
  i:=Sak_koll(Order);
  IF i>0 THEN
  BEGIN
    Itta(i);
    nr:=FinnOpp2(i,1);
    IF nr<>0 THEN
    BEGIN
      IF Open(.nr.)=0 THEN SkrivStext(57,S_nam(i));
      IF (Open(.nr.)=3) or (Open(.nr.)=2) THEN Skrivstext(47,S_nam(i));
      nyck:=Sakvar(.Nyckel(.nr.),2.);
      IF (Open(.nr.)=1) and (nyck<>-1) THEN SkrivStext(48,'');
      IF (Open(.nr.)=1) and (nyck=-1) THEN
      BEGIN
        Open(.nr.):=3;
        Writeln(OK);More;
      END;
    END ELSE SkrivStext(56,'');
  END;
 END;
END;

Procedure upplosa(Order:RADSTR);

var i,nr,nyck:INTEGER;

BEGIN
  IF Kolla_men(Order,2) THEN
 BEGIN
  i:=Sak_koll(Order);
  IF i>0 THEN
  BEGIN
    Itta(i);
    nr:=FinnOpp2(i,1);
    IF nr<>0 THEN
    BEGIN
      IF (Open(.nr.)=1) THEN SkrivStext(44,S_nam(i));
      nyck:=Sakvar(.Nyckel(.nr.),2.);
      IF (Open(.nr.)=3) and (nyck<>-1) THEN SkrivStext(48,'');
      IF (Open(.nr.)=3) and (nyck=-1) THEN
      BEGIN
        Open(.nr.):=1;
        Writeln(OK);More;
      END;
    END ELSE SkrivStext(55,'');
  END;
 END;
END;

Procedure Turn_onoff(Order:RADSTR);

var po:BOOLEAN;
     i:INTEGER;

BEGIN
  maxmen:=Antal_ord(Order);
  IF Kolla_men(Order,3) THEN
 BEGIN
  car:=True;
  IF (Ordnr(Order,2)=Ordd(.22.)) THEN
  BEGIN
    po:=True; Order:=Ord_grupp(Order,3,maxmen);
  END
  ELSE IF (Ordnr(Order,2)=Ordd(.29.)) THEN
  BEGIN
    po:=False; Order:=Ord_grupp(Order,3,maxmen);
  END
  ELSE IF (Ordnr(Order,maxmen)=Ordd(.22.)) THEN
  BEGIN
    po:=True; Order:=Ord_grupp(Order,2,maxmen-1);
  END
  ELSE IF (Ordnr(Order,maxmen)=Ordd(.29.)) THEN
  BEGIN
    po:=False; Order:=Ord_grupp(Order,2,maxmen-1);
  END
  ELSE BEGIN SkrivStext(46,'');car:=False;END;
  IF car THEN
  BEGIN
    i:=Sak_koll('abc '+Order);
    IF i>0 THEN
    BEGIN
      Itta(i);
      IF i<>4 THEN SkrivStext(59,'')
      ELSE
      BEGIN
        Kladd(.3.):=po;
        IF Kladd(.3.) THEN SkrivStext(58,Ordd(.22.))
        ELSE SkrivStext(58,Ordd(.29.));
      END;
    END;
  END;
 END;
END;

Procedure Light(Order:RADSTR);

BEGIN
  Turn_onoff('turn on '+Ord_grupp(Order,2,Antal_ord(Order))+' ');
END;

Procedure Las(Order:RADSTR);

var i:INTEGER;

BEGIN
  IF Kolla_men(Order,2) THEN
 BEGIN
  i:=Sak_koll(Order);
  IF i>0 THEN
  BEGIN
    Itta(i);
    IF i=9 THEN
    BEGIN
      IF Kladd(.3.) THEN
      BEGIN Skrivtext(7); Vagar(.28,8.):=30;score:=score+5;END
      ELSE SkrivSak(9,'at');
    END
    ELSE IF i=7 THEN Skrivtext(8)
    ELSE IF i=12 THEN Skrivtext(9)
    ELSE SkrivStext(60,'');
  END;
 END;
END;

Procedure Quit;

var ch:CHAR;

BEGIN
  Writeln('Are you sure you want to quit now?  (y/n)');
  REPEAT Read(kbd,ch); UNTIL ch IN ['Y','y','N','n'];
  IF ch IN ['y','Y'] THEN Sluta:=True;
END;

Procedure Press(Order:RADSTR);

var i,t:INTEGER;

BEGIN
  IF Kolla_men(Order,2) THEN
  BEGIN
    i:=Sak_koll(Order);
    IF i>0 THEN
    BEGIN
      Itta(i);
                  (* H„r kommer hissknapparna  *)
      IF (i>68) and (i<75) THEN
      BEGIN
        Skrivstext(64,'');

        FOR t:=4 TO 9 DO IF Open[t]=0 THEN t:=20;
        IF t<20 THEN
        BEGIN
          moving:=abs(Hiss-i+69)*3;
          Hiss:=i-69;
          FOR t:=4 TO 9 DO Open[t]:=3;
          FOR t:=0 TO 5 DO Sakvar[Elev2[t],7]:=Elev1[t];
          Sakvar[Elev2[Hiss],7]:=40;
          Vagar[40,2]:=-Hiss-4;

        END;
      END
      ELSE
           (* H„r kommer knapparna inuti hissen *)
      IF (i>80) and (i<88) THEN
      BEGIN
        Skrivstext(64,'');

        FOR t:=4 TO 9 DO IF Open[t]=0 THEN t:=20;
        IF t<20 THEN
        BEGIN
          moving:=abs(Hiss-i+81)*3;
          Hiss:=i-81;
          FOR t:=4 TO 9 DO Open[t]:=3;
          FOR t:=0 TO 5 DO Sakvar[Elev2[t],7]:=Elev1[t];
          Sakvar[Elev2[Hiss],7]:=40;
          Vagar[40,2]:=-Hiss-4;
        END;
      END
      ELSE Skrivstext(74, Saknamn[i]);
    END;
  END;
END;

Procedure Give(Order:RADSTR);

var p,i,t,f1,f2,f3,s1,s2,s3:BYTE;
BEGIN
  IF Kolla_men(Order,4) THEN
  BEGIN
    p:=Hittaprep(Order,25);
    IF p<3 THEN
    BEGIN
      Writeln('Gotcha! Something is missing in that sentence.');
      Writeln('Try GIVE something TO someone.');
    END
    ELSE
    BEGIN
      t:=Sak_koll(Ord_grupp(Order, 1, p-1));
      i:=Sak_koll(Ord_grupp(Order, p, Antal_ord(Order)));
    END;
    IF (i>0) and (t>0) and (p>2) THEN
    BEGIN
      Itta(t);
      IF Sakvar(.i,8.)<>4 THEN Writeln('Don''t expect the ',S_nam(i),' to applaud.')
      ELSE
      BEGIN
        IF (t=28) and (i=62) THEN
        BEGIN
          Writeln('Paul: Thanks! Now I can play the violin. I hate all other composers than Kreisler');
          Writeln('      You know something? I think I gonna lend you my B-key. Just because');
          Writeln('      you have been so kind.');
          Writeln('Paul hands you a key and you take it.');
          Sakvar(.15,2.):=-1;
          Sakvar(.15,7.):=-1;
          Sakvar(.28,2.):=0;
          Sakvar(.28,7.):=0;
          i:=FinnOpp2(62,4);
          Tillstand(.i.):=2;
          score:=score+5;
        END
        ELSE
        BEGIN
          IF (rum=51) THEN
          BEGIN
            f1:=Sak_nr('Hm johannes ');
            f2:=Sak_nr('Hm ole ');
            s1:=Sak_nr('Hm chessboard ');
            s2:=Sak_nr('Hm black pieces ');
            s3:=Sak_nr('Hm white pieces ');
          END
          ELSE IF (rum=36) THEN
          BEGIN
            f1:=Sak_nr('Hm cleaning broom ');
            s1:=Sak_nr('Hm cleaning man ');
          END ELSE BEGIN f1:=-3; f2:=-3; s1:=-3; s2:=-3; s3:=-3; END;

          IF (t=s1) or (t=s2) or (t=s3) THEN
          BEGIN
          IF (rum=51) and ((i=f1) or (i=f2)) THEN
          BEGIN
            Sakvar(.t,2.):=0;
            Sakvar(.t,7.):=0;
            IF (t=s1) THEN ches1:=1;
            IF (t=s2) THEN ches2:=1;
            IF (t=s3) THEN ches3:=1;
            IF (ches1=1) and (ches2=0) and (ches3=0) THEN
              Writeln(S_nam(i),':  Great! But we have no pieces!');
            IF (ches1=0) and ((ches2=1) or (ches3=1)) THEN
              Writeln(S_nam(i),':  Great! But we have no chessboard!');
            IF (ches1=1) and ((ches2=1) xor (ches3=1)) THEN
              Writeln(S_nam(i),':  We are still missing pieces meathead!');
            IF (ches1=1) and (ches2=1) and (ches3=1) THEN
            BEGIN
              Writeln(S_nam(i),':  SUPER! We''ve got a chessboard, black pieces and white pieces.');
              Writeln('           Let''s play! And you, (',S_nam(i),' turns against you) you give');
              Writeln('           us som peace, so we can play undisturbed!');
              pl:=6;
              tillstand(.Finnopp2(f1, 4).):=5;
              tillstand(.Finnopp2(f2, 4).):=5;
            END;
          END;
          END ELSE
          IF (rum=36) and (t=s1) and (i=f1) THEN
          BEGIN
            Sakvar(.t, 2.):=0;
            Sakvar(.t, 7.):=0;
            Vagar(.36, 10.):=45;
            Writeln('Cleaner:  Merci! Maintenent, je peux fair mon travail!')
          END
          ELSE Writeln(S_nam(i),' refuses your offer.');
        END;
      END;
    END;
  END;
END;

Procedure Takeon(Order:RADSTR);

BEGIN
  IF Kolla_men(Order,2) THEN
  BEGIN
    i:=Sak_koll(Order);
    IF i>0 THEN
    BEGIN
      Itta(i);
      IF Sakvar[i,8]<>3 THEN Writeln('You can''t wear a ', S_nam(i))
      ELSE
      BEGIN
        wear[finnopp2(i,3)]:=1;
        Sakvar[i,2]:=-1;
        Sakvar[i,7]:=-1;
        Writeln(OK);
      END;
    END;
  END;
END;

Procedure Wake(Order:RADSTR);
var i,t:INTEGER;

BEGIN
  IF Kolla_men(Order,2) THEN
  BEGIN
    i:=Sak_koll(Order);
    IF i>0 THEN
    BEGIN
      Itta(i);
      IF Sakvar[i,8]<>4 THEN Writeln('You can''t wake a ', S_nam(i))
      ELSE
      BEGIN
        t:=Sak_nr('Hm mika ');
        IF i=t THEN
        BEGIN
          tillstand[finnopp2(i,4)]:=1;
          Writeln('Mika looks drowsely up. He is at least alive!');
          IF (Sakvar(.50, 2.)=-1) or (Sakvar(.50,2.)=38) THEN
          BEGIN
            Writeln('Mika takes the cup of coffee and gulps it all down in a few seconds.');
            Writeln('Mika:  Wow! What a nap!');
          END ELSE
          BEGIN
            Writeln('Unfortunately he almost instantly falls asleep again.');
            Writeln('Mika:  ZZZZZZzzzzzzzzz');
            tillstand[finnopp2(i,4)]:=4;
          END;
        END;
      END;
    END;
  END;
END;

Procedure Put(Order:RADSTR);

var mem:RADSTR;
var p, i,t, z,q, o:INTEGER;
label RETURN;

BEGIN
  IF Kolla_men(Order,4) THEN
  BEGIN
    z:=Sak_koll('plastic cup ');
    q:=Sak_koll('coffee machine ');
    p:=Hittaprep(Order,11);
    Writeln('DEBUG> p=', p);
    IF p<3 THEN
    BEGIN Writeln('Somethin missin man! Rephrase please!');Goto RETURN;END;
    i:=Sak_koll(Ord_grupp(Order, 1, p-1));
    t:=Sak_koll(Ord_grupp(Order, p, Antal_ord(Order)));
    IF (i>0) AND (t>0) THEN
    BEGIN
      Itta(i);
      IF (i<>z) OR (t<>q) THEN Writeln('You can''t put that in that.')
      ELSE
      BEGIN
        Renshit;
        o:=Hitta_sak(1000);
        o:=Hitta_namn('coffee');
        o:=Hitta_hit;
        Sakvar[i,2]:=0;
        Sakvar[i,7]:=0;
        Sakvar[o,2]:=-1;
        Sakvar[o,7]:=-1;
        Writeln('Your cup slowly fills with coffee. After a while it''s ready for drinking.');
        Writeln('You take the cup again.');
      END;
    END;
  RETURN:
  END;
END;


Procedure Utfor_order(Order:RADSTR);

var val :BYTE;

BEGIN
  car:=True;
  IF Finnrikt(Ordnr(Order,1))>0 THEN Insert('go ',Order,1);
  val:=Hitta_order(Ordnr(Order,1));
  IF val>0 THEN
  Case val of
    1 : Walk(Order);
    2 : Get(Order);
    3 : Drop(Order);
    4 : Look(Order);
    5 : Inventory;
    6 : Quit;
    7 : Examine(Order);
    8 : Oppna(Order);
    9 : Stang(Order);
   10 : Upplosa(Order);
   11 : Losa(Order);
   12 : Las(Order);
   14 : Turn_onoff(Order);
   15 : light(Order);
   16 : Press(Order);
   17 : Wake(Order);
   18 : Put(Order);
   19 : Give(Order);
   20 : Takeon(Order);
  END
  ELSE
  BEGIN
    Stega(2,5);
    Skrivstext(10+Steg(.2.),Ordnr(Order,1));
    car:=False;
  END;
END;


Function And_koll(Order:RADSTR):RADSTR;

var i,t,max:BYTE;
     svar:RADSTR;

BEGIN
 svar:='';i:=0;max:=Antal_ord(Order);forder:='';
  IF Ordnr(Order,1)=Ordd(.18.) THEN Delete(Order,1,4);
  IF Ordnr(Order,1)='' THEN
  BEGIN
    SkrivStext(46,'');
    i:=max+1;
    carr:=False;
  END;
  REPEAT
    i:=i+1;
    IF (i<=max) and (Ordnr(Order,i)<>Ordd(.18.))  THEN
    svar:=svar+Ordnr(Order,i)+' ';
  UNTIL (i>max) or (Ordnr(Order,i)=Ordd(.18.));
  FOR t:=i+1 TO max DO forder:=forder+Ordnr(Order,t)+' ';
  IF forder<>'' THEN IF Ordnr(forder,1)='' THEN forder:='';
  And_koll:=svar;
END;

Function It_koll(Order:RADSTR):RADSTR;

var i,max:BYTE;
       svar:RADSTR;

BEGIN
  svar:='';max:=Antal_ord(Order);
  carr:=True;
  BEGIN
    for i:=1 TO max DO
    IF Ordnr(Order,i)=Ordd(.27.) THEN
      IF ITT='' THEN BEGIN skrivstext(45,'');carr:=False;END
      ELSE svar:=svar+ITT+' '
    ELSE
    svar:=svar+Ordnr(Order,i)+' ';
  END;
  It_koll:=Svar;
END;

Function Renschange(Order:RADSTR):RADSTR;

var i:INTEGER;
    c:CHAR;

BEGIN
  Order:=' '+Order+' ';
  FOR i:=1 TO length(Order) DO IF Copy(Order,i,1)=',' THEN
  BEGIN
    Delete(Order,i,1);
    Insert(' , ',Order,i);
  END;
  FOR i:=1 TO length(Order) DO IF Copy(Order,i,1)='&' THEN
  BEGIN
    Delete(Order,i,1);
    Insert(' '+Ordd(.18.)+' ',Order,i);
  END;
  FOR i:=1 TO length(Order) DO
  BEGIN c:=Copy(Order,i,1);
    IF c IN ['.',';',':','!','"'] THEN
    BEGIN
      Delete(Order,i,1);
      Insert(' ',Order,i);
    END;
  END;
    FOR i:=1 TO length(order) DO IF Copy(Order,i,6)=' '+Ordd(.28.)+' ' THEN
  BEGIN
    Delete(Order,i,6);
    Insert(' '+Ordd(.18.)+' ',Order,i);
  END;
    FOR i:=1 TO length(order) DO IF Copy(Order,i,5)=' '+Ordd(.3.)+' ' THEN
  BEGIN
    Delete(Order,i,5);
    Insert(' ',Order,i);
  END;
  Renschange:=Order;
END;

Procedure TRAIN;
BEGIN
  IF (Rum=8) or (Rum=12)THEN
  BEGIN
    Skrivtext(1);
    Rum:=28;
    Ga_rum(28,0);
  END;
END;

Procedure HELL;
BEGIN
  IF (Rum=29) THEN
  BEGIN
    Rum:=1;
    Skrivtext(4);
  END;
END;

Procedure FINDLAMP;

BEGIN
  IF Kladd(.1.)=False THEN
  BEGIN
    Skrivtext(5);
    Sakvar(.4,2.):=25;
    Kladd(.1.):=True;
    ITT:=Ord_grupp(Saknamn(.4.),2,Antal_ord(Saknamn(.4.)));
  END;
END;

Procedure WAKEUP;

var i:BYTE;

BEGIN
  IF rum=30 THEN
  BEGIN
    rum:=31;
    Skrivtext(6);
    Ga_rum(31,0);
    FOR i:=1 TO 9 DO IF Sakvar(.i,2.)=-1 THEN
    BEGIN Sakvar(.i,2.):=0;Sakvar(.i,7.):=0;END;
    IF Sakvar(.12,2.)=-1 THEN
    BEGIN Sakvar(.12,2.):=0;Sakvar(.12,7.):=0;END;
  END;
END;

Procedure FINDNOTES;

var i:INTEGER;

BEGIN
  IF notegot=0 THEN
  FOR i:=26 TO 28 DO
  BEGIN
    Sakvar(.i,2.):=39;
    Sakvar(.i,7.):=39;
    Sakvar(.i,3.):=0;
  END;
  notegot:=1;
END;

Procedure PILEFIND;

var i:INTEGER;

BEGIN
  IF piled=0 THEN
  BEGIN
    Skrivstext(72, '');
    Sakvar(.4,2.):=-1;
    Sakvar(.4,7.):=-1;
    Sakvar(.4,3.):=0;
    piled:=1;
  END
  ELSE SkrivStext(73, '');
END;

Procedure HISSUM;

var i:INTEGER;

BEGIN
  IF moving>0 THEN
  BEGIN
    moving:=moving-1;
    IF rum IN [40,36,37,45,58,68,87] THEN Skrivstext(76, '');
    IF moving=0 THEN
    BEGIN
      Open[4+Hiss]:=1;
      IF (rum=Elev1[hiss]) or (rum=40) THEN Skrivstext(65, '');
    END;
  END;
END;

Procedure LIBRARY;

BEGIN
  IF rum=47 THEN
  BEGIN
    lib:=succ(lib);
    IF lib=2 THEN
    BEGIN
      IF wear[1]=0 THEN
      BEGIN
        Writeln('Suddenly Sohlman''s music lexikon tips over the edge and falls right onto your');
        more;
        Writeln('head. Unfortunately, this book is very heave and your skull won''t hold.');
        more;
        Writeln('You adventure came abruptly to an end.');
        more;
        sluta:=TRUE;
      END
      ELSE
      BEGIN
        Writeln('Suddenly Sohlman''s music lexikon tips over the edge and falls. Luckily for you');
        more;
        Writeln('the helmet takes the strike and the book slides off your head without doing');
        more;
        Writeln('any harm.');
        more;
        score:=score+5;
      END;
    END;
  END;
END;

Procedure Hande2;
BEGIN
  CASE va OF
    1 : TRAIN;
    2 : HELL;
    3 : HISSUM;
    4 : FINDLAMP;
    5 : WAKEUP;
    6 : FINDNOTES;
    7 : PILEFIND;
    8 : LIBRARY;
    9 : ;
  END;
END;


Procedure Handelsekoll;

var i:INTEGER;

BEGIN
  FOR i:=1 TO hand DO
  IF (move=Handnr(.i,1.)) and ((vagar(.rum,11.)=handnr(.i,2.)) or
  (handnr(.i,2.)=0)) THEN Skrivhandelse(i);
  IF (move=Handnr(.i,1.)) and (handnr(.i,2.)=-1) THEN
  BEGIN
    Skrivhandelse(i);
    Sluta:=True;
  END;
  Hande2(1);
  Hande2(2);
  Hande2(3);
  Hande2(5);
  Hande2(8);
  Hande2(9);
END;

Procedure Scoring;
BEGIN
  Writeln;
  Writeln('You got a score ',score,' out of 10.');
  Write('That makes you to ');
  IF score=0 THEN Writeln('a complete missed beeing.');
  IF (score>0) and (score<40) THEN Writeln('a beginner adventurer.');
END;

Function Question:BOOLEAN;

var rd:RADSTR;
     sv:BYTE;

BEGIN
  Writeln;
  Write('Do you want to enter this condemnable game once more?');
  sv:=0;
  REPEAT
    Readln(rd);
    IF Lowcase_order(rd)='yes' THEN sv:=1;
    IF Lowcase_order(rd)='no' THEN sv:=2;
    IF sv=0 THEN Write('Answer positively or negatively! Yes or no? ');
  UNTIL sv<>0;
  if sv=1 THEN Question:=TRUE ELSE Question:=FALSE;
END;

(*      H{r kommer huvud lopen    *)

var AGAIN:BOOLEAN;

BEGIN
AGAIN:=FALSE;
REPEAT
  Init;
  Filinit;

  Assign(ADVFIL2, Filnamn);
  Reset(ADVFIL2);

  rum:=1;
  Sakvar[51, 2]:=31;

  Ga_rum(rum,0);
  carr:=True;
  car:=False;
  REPEAT
    IF forder<>'' THEN Men:=forder
    ELSE
    IF gorder<>'' THEN Men:=gorder
    ELSE
    Men:=Order;
    Men:=Lowcase_order(Men);
    IF carr THEN Men:=Renschange(Men);  { writeln('a',men,'a');}
    IF carr THEN Men:=Snygg_order(Men); { writeln('b',men,'b');}
    IF carr THEN Men:=And_koll(Men);    { writeln('c',men,'c');}
    IF carr THEN Men:=It_koll(Men);     { writeln('d',men,'d');}
    IF carr THEN maxmen:=Antal_ord(Men);{ writeln('e',men,'e'); }
    IF carr=True THEN Utfor_order(Men) ELSE car:=False;
    IF car THEN BEGIN Handelsekoll; move:=move+1;END;
    gmen:=men;
  UNTIL Sluta;
  Close(ADVFIL2);
  Scoring;
  AGAIN:=Question;
UNTIL AGAIN=FALSE;
END.