%externalroutine rat(%string (255) s)
%externallongrealfnspec cputime
%externalrealfnspec random(%integername i, %integer n)
%externalstring (255) %fnspec time
%externalroutinespec terminate
      %routinespec clear screen
      %routinespec pepos(%integer x, y)
      %%integer %fn %spec test door


      %externalroutinespec prompt(%string (17) s)

%ownbyteintegerarray door(10:66) =
 0, 2, 3, 4, 1, 1, 1, 0, 0, 0, 
 0, 2, 3, 4, 5, 1, 1, 0, 0, 0,
 0, 6, 3, 7, 1, 1, 1, 0, 0, 0,
 0, 6, 3, 8, 1, 1, 1, 0, 0, 0,
 0, 6, 3, 1, 1, 1, 1, 0, 0, 0,
 0, 7, 3, 1, 1, 1, 1
      ! 0 - error, 1 - door is open
      ! 2 - electrified, 
      ! 3 - locked
      ! 4 - monofilament criss-cross - take alertness check
      ! 5 - anti - decompression door
      ! 6 - gas spurts from jamb
      ! 7 - on c-deck door is open, otherwise 4
      ! 8 - drenching with water

      %conststring (127) %array penalty(0:2) = %c
      "********** you are ok",
      "********** you have been stunned",
      "********** you are either dead or wounded ***********"

      %conststring (9) room desc(1:6) = %c
      "Industrial", "Service", "Corridor", "living",
      "Accessway", "Computer"

      %constbyteintegerarray room d(0:6) = %c
      'I', 'S', 'C', 'L', 'A', 'M'

      %constintegerarray gas gren(2:12) = %c
      0, 1(6), 2, 1, 2(3)
      %constintegerarray slug(2:12) = %c
      0(5), 1(2), 2(5)
      %constintegerarray expl gren(2:12) = %c
      0(4), 2, 0, 2, 1, 2(4)
      %constintegerarray laser pistol(2:12) = %c
      0(6), 1, 2(5)
      %constintegerarray elect prod(2:12) = %c
      0(3), 1(3), 2(*)
      %constintegerarray gas gun(2:12) = %c
      0(5), 1, 0, 1, 2(*)
      %constintegerarray laser(2:12) = %c
         0(4), 2, 1, 2(3), 1, 2(*)
      %constintegerarray smg(2:12) = %c
         0, 1(4), 2, 1, 2(*)

      %ownbyteintegerarray side(0:576) = 0(*)
      %ownbyteintegerarray desc(0:576) = 0(*)
      %ownbyteintegerarray dd(0:5) = %c
         'd', ' ', '-', 'l', 'e', 's'

      %integer deck, sqx, sqy, posx, posy, refx, top, sqv
      %owninteger my posx = -1, my posy = -1
      %owninteger current room = 0
      %owninteger disbelief = 75, alertness = 9
      %constinteger esc = 27
      %owninteger term type = 'L'


      %integer i, j, alert
      %ownintegerarray test ran(0:6) = 0(7)
      %routine psym(%integer x)
         printch(x)
      %end

      %routine pepos(%integer x,y)
         ! nb: in this one, x is accross and y is vertical
         %if term type = 'P' %start
            psym(esc);  psym('Y');  psym(x+31)
            psym(esc);  psym('X');  psym(y+31)
         %finish %else %start
            %if term type = 'N' %start
               psym(x'16'); psym(x+' '-1); psym(y+' '-1)
            %finishelsestart
            psym(24)
            %IF y # 11 %THENSTART
               psym(y-1);  psym(x-1)
            %FINISHELSESTART
               psym(9);  psym(x-1);  psym(11)
            %FINISH
            %finish
         %finish
      %end 
      %routine peclear
      %if term type = 'P' %start
         psym(esc);  psym('K')
      %finish %else %start
         %if term type = 'N' %start
            psym(x'1d'); psym(x'1f')
         %finishelsestart
            psym(1); psym(12)
         %finish
      %finish
         terminate
      %end 

%integerfn randomize(%integer range)
%integer i, j
%string (23) ti
%owninteger init = 0
%owninteger start = 123457
%longreal res,last
      %if init = 0 %start
         init = 1
         ti = time
         i = charno(ti,8)-'0'+1
         start = start*i*2+1
      %finish
      res = random(start, 1)
   %result = intpt(res * range + 1)
%end

      %integer %fn roll
         %integer i
         %result = randomize(6)
      %end

      %integer %fn double roll
         %integer x, y
         x = roll; y = roll
         %result = x*10+y
      %end
      %routine skip to end
         %integer i
         %cycle
            readsymbol(i); %return %if i = nl
         %repeat
      %end

      %integer %fn get sym
         %integer i, j
         readsymbol(i)
         %if 'A' <= i <= 'Z' %then i = i-'A'+'a'
         %result = i
      %end

      %integer %fn get yn
         %integer i, j, k
         prompt("y/n:")
         %cycle
            i = get sym
            %if i = 'y' %or i = 'n' %start
               skip to end
               %result = i
            %finish
         %repeat
      %end

      %integer %fn left(%integer sqx, sqy)
         %result = side(sqx+sqy*64+deck*192)&15
      %end

      %integer %fn right(%integer sqx, sqy)
            %result = side((sqx+1)&63+sqy*64+deck*192)&15
      %end

      %integer %fn up(%integer sqx, sqy)
         %result = (side(sqx+sqy*64+deck*192))>>4
      %end

      %integer %fn down(%integer sqx, sqy)
         %if sqy = 3 %then %result = 2; ! wall
         %result = side(sqx+(sqy+1)*64+deck*192)>>4
      %end
      %routine nleft(%integer x, y, n)
         %integer k
         k = x+y*64+deck*192
         side(k) = side(k)!n
      %end

      %routine nright(%integer x, y, n)
         %integer k, p
         k = (x+1)&63+y*64+deck*192
         side(k) = side(k)!n
      %end

      %routine nup(%integer x, y, n)
         %integer k
         k = sqx+sqy*64+deck*192
         side(k) = side(k)!(n<<4)
      %end

      %routine ndown(%integer x, y, n)
         %integer k
         k = sqx+(sqy+1)*64+deck*192
         side(k) = side(k)!(n<<4)
      %end


      %routine draw sq(%integer sqx, sqy)
         %integer i, j, k, sqv, posx, posy
         sqv = sqx+sqy*64+deck*192
         %if desc(sqv) # 0 %start;      ! already disclosed
            k = sqx-refx; k = k+64 %if k < 0
            posx = 1+(k)*4; posy = 5+sqy*4
            pepos(22,22); write(posx, 1); write(posy, 1); newline
            pepos(posx, posy)
            printstring("+-")
            printsymbol(dd(up(sqx, sqy)))
            printstring("-+")
            pepos(posx, posy+1)
            printstring("|   |")
            pepos(posx, posy+2)
            printsymbol(dd(left(sqx, sqy)))
            spaces(3)
            printsymbol(dd(right(sqx, sqy)))
            pepos(posx, posy+3); printstring("|   |")
            pepos(posx, posy+4); printstring("+-")
            printsymbol(dd(down(sqx, sqy))); printstring("-+")
         %finish
         terminate
      %end

      %routine pict(%integer sqx, sqy)
         %integer i, j, k

         peclear
         refx <- (sqx-6)&63
         %cycle i = 0, 1, 12
            %cycle j = 0, 1, 3
               draw sq((refx+i)&63, j)
            %repeat
         %repeat
      %end

      %integer %fn try door(%integer res)
         %integer a, b, c
         %if res = 0 %then %result = test door
         %result = res
      %end

      %integer %fn test alertness
         %integer i
         printstring("What is your alertness value?"); newline
         prompt("Value?")
         read(alert); skipsymbol
         i = roll+roll
         %if alert >= i %start
            printstring("You passed the test, so:-
")
            %result = 0
         %finish
         printstring("You failed !
")
         %result = 1
      %end

      %integer %fn try room
         %integer i, j, k
         printstring("Use paragraph"); write(double roll, 2)
         printstring(" for the relevent type of room
")
         %result = 0
      %end

      %integer %fn laser cutter
         %switch sw(2:12)
         %integer i, j, num
         -> sw(roll+roll)

sw(2):   printstring("Laser overheats and interior components melt down
")
      -> fail

sw(3):   printstring("You have dropped the laser and something went crunch
")
      -> fail

sw(4):   printstring("While cutting, the laser cuts into a water vent, the ")
         printstring("laser is short-circuited.
How many robots do you control?
")
         prompt("number?")
         %cycle
            i = nextsymbol
            %if '0'<=i<='9' %then %exit
            skipsymbol
         %repeat
         read(num); skipsymbol
         i = 0
         -> fail %if num = 0
         %cycle j = 1, 1, num
            %if roll = 1 %then i = i+1
         %repeat
         %if i = 0 %start
            printstring("No further damage has occured
")
         %finish %else %start
            printstring("You have lost"); write(i, 1); printstring(" robots
")
         %finish
         -> fail
sw(5): sw(6): sw(7): sw(8): sw(9):
      printstring("You have succeeded in cutting through
")
      %result = 0

sw(10):  printstring("You have been splashed by molten metal, are you")
         printstring(" wearing a suit?
")
         i = get yn
         %if i = 'y' %start
            printstring("The suit malfunctions!
")
         %finish %else %start
            printstring(penalty(2)); newline
         %finish
         -> sw(5)

sw(11):  printstring("The warranty on the laser ran out today! It has")
         printstring(" just failed
")
         -> fail

sw(12):  printstring("Who forgot to replace the power pack?
")
fail:    printstring("You failed to cut through  -  discard the laser
")
         %result = 1
      %end

      %routine weapons table
         %integer i, j, x, kill, prot
         %constbyteintegerarray type(1:4) = 'g', 'e', 'l', 's'
         %switch sw(1:4)

         printstring("Weapon type:-
      g - gas, e - electric prod, l - laser, s - smg
")
         prompt("type?")
         %cycle
            x = get sym
            %cycle j = 1, 1, 4
               %if x = type(j) %start
                  kill = roll+roll
                  printstring("How many of the attackers arms are wounded?
")
                  prompt("0/1/2?")
                  read(prot)
                  %if prot = 1 %then kill = kill-1
                  %if prot = 2 %then kill = kill-3
                  %if kill<0 %then kill = 0
                  -> sw(j)
               %finish
            %repeat
         %repeat

sw(1):
         printstring(penalty(gas gun(kill)))
         %return

sw(2):
         printstring(penalty(elect prod(kill)))
         %return

sw(3):
         printstring("Are you smoking a cigar (1) or wearing reflective ")
         printstring("armour (3) - else say (0)
")
         prompt("0/1/3?"); read(prot)
         kill = kill-prot
         printstring(penalty(laser(kill)))
         %return

sw(4):
         printstring(penalty(smg(kill)))
         %return
      %end


      %integerfn test door
         %integer i, j, k
         %switch sw(0:8)
         k = double roll
         j = door(k)
         -> sw(j)

sw(0):
      printstring("program error
")
      %stop

sw(1):   ! ok
sw1:  printstring("you are through
")
      %result = 1

sw(2):   ! electrified
      printstring("The door is electrified - are you wearing gloves?
")
      i = getyn
      %if i = 'y' %then -> sw1
      printstring(penalty(elect prod(roll+roll))); newline
failed:
      printstring("You have failed to pass through
")
      %result = 4

sw(3):   ! locked
      printstring("The door is locked - do you have a lockpick?
")
      i = getyn
      %if i = 'y' %then ->sw1
      %result = 3

sw(4):   ! monofilament
      i = test alertness
      %if i = 0 %start
         printstring("You spotted the monofilament criss cross over the door")
         printstring(" in time, but ")
         %result = 5
      %finish
      printstring("You walked into a monofilament criss cross over the door")
      printstring(" and .....
")
      printstring(penalty(2)); newline
      -> failed

sw(5):   ! anti-decompression door
      printstring("As you attempt to open the door a steel anti-decompression
seal slams accross the doorway
")
      i = test alertness
      %if i = 1 %start
         printstring("Do you have a lockpick in your hand?
")
         i = getyn
         %if i = 'y' %start
            printstring("The lockpick is destroyed
")
         %finish %else %start
            printstring(penalty(2))
         %finish
      %finish
      -> failed

sw(6):   ! gas
      printstring("As you open the door, GAS spurts out from the jamb
Do you have an undamaged suit?
")
      i = getyn
      -> sw1 %if i = 'y'
      printstring(penalty(gas gun(roll+roll)))
      -> sw1

sw(7):   ! ok on c-deck, otherwise 4
      printstring("Are you on C-deck
")
      i = getyn
      -> sw1 %if i = 'y'
      -> sw(4)

sw(8):   ! water
      pepos(1, 23)
      printstring("Some juvenile nitwit has left a bucket of water balanced
over the door, the bucket falls on you, drenching you with water.
If you have a CUTTING LASER or a LASER WEAPON in your hand it is destroyed
")
      -> sw1
      %end

      deck = 0
      sqx = 0; sqy = 0; refx = 0
      desc(0) = 1
      pict(sqx, sqy)

x:

      pepos(1, 23);newline
      prompt("Go?")
      i = get sym
      skip to end
      %if i = 't' %start
         i = test door
         %if i = 0 %then i = try room
      -> x
      %finish
      %if i = 'z' %start
         write(roll, 1); newline
         -> x
      %finish
      %if i = 'c' %start
         i = laser cutter
         %if i = 0 %then i = try room
         -> x
      %finish
      %if i = 'w' %start
         weapons table
         newline; skip to end
         -> x
      %finish
      %if i = 'l' %start;               ! move left
         j = try door(left(sqx, sqy))
         -> fail it %if j # 1
         nleft(sqx, sqy, j)
         sqx = (sqx-1)&63
         -> test it
      %finish

      %if i = 'r' %start;               ! move right
         j = try door(right(sqx, sqy))
         nright(sqx, sqy, j)
         -> fail it %if j # 1
         sqx = (sqx+1)&63
         -> test it
      %finish

      %if i = 'u' %start;               ! move 'up'
         %if sqy = 0 %then -> fail it
         j = try door(up(sqx, sqy))
         nup(sqx, sqy, j)
         -> fail it %if j # 1
         sqy = sqy-1
         -> test it
      %finish

      %if i = 'd' %start;               ! move 'down'
         %if sqy = 3 %then->fail it
         j = try door(down(sqx, sqy))
         ndown(sqx, sqy, j)
         -> fail it %unless j = 1
         sqy = sqy+1
test it:
         pepos(0, 23)
         printstring("you are through
")
         desc(sqx+sqy*64+deck*192) = 1
         %if sqx = refx %or sqx = (refx+11)&63 %then pict(sqx, sqy) %else %c
            draw sq(sqx, sqy)
         -> out
         
fail it: pepos(1, 23)
         printstring("sorry, can't go that way
")
         draw sq(sqx, sqy)
      %finish
out:

      %if i = 'p' %start
         pict(sqx, sqy)
      %finish

      %if i = 'q' %start
         %cycle j = 1, 1, 1000
            test ran(roll) = test ran(roll)+1
         %repeat
         %cycle i = 0, 1, 6
            write(i, 2); write(test ran(i), 3)
            newline
         %repeat
      %finish
      -> x
%end
%endoffile