-+-+-+-+-+-+-+-+ START OF PART 3 -+-+-+-+-+-+-+-+ X IF F `5BY-1,X`5D = NOTHING THEN X BEGIN X F `5BY-1,X`5D := BUTTERFLY1; X F `5BY,X`5D := NOTHING; X END X ELSE F `5BY,X`5D := BUTTERFLY0; X BUTTERFLY2: X IF F `5BY+1,X`5D = NOTHING THEN X BEGIN X F `5BY+1,X`5D := BUTTERFLY3; X F `5BY,X`5D := NOTHING; X END ELSE X IF F `5BY,X+1`5D = NOTHING THEN X BEGIN X F `5BY,X+1`5D := BUTTERFLY2; X F `5BY,X`5D := NOTHING; X END X ELSE F `5BY,X`5D := BUTTERFLY1; X BUTTERFLY3: X IF F `5BY,X-1`5D = NOTHING THEN X BEGIN X F `5BY,X-1`5D := BUTTERFLY0; X F `5BY,X`5D := NOTHING; X END ELSE X IF F `5BY+1,X`5D = NOTHING THEN X BEGIN X F `5BY+1,X`5D := BUTTERFLY3; X F `5BY,X`5D := NOTHING; X END X ELSE F `5BY,X`5D := BUTTERFLY2; X SQUAREFLY0: X IF F `5BY+1,X`5D = NOTHING THEN X BEGIN X F `5BY+1,X`5D := SQUAREFLY3; X F `5BY,X`5D := NOTHING; X END ELSE X IF F `5BY,X-1`5D = NOTHING THEN X BEGIN X F `5BY,X-1`5D := SQUAREFLY0; X F `5BY,X`5D := NOTHING; X END X ELSE F `5BY,X`5D := SQUAREFLY1; X SQUAREFLY1: X IF F `5BY,X-1`5D = NOTHING THEN X BEGIN X F `5BY,X-1`5D := SQUAREFLY0; X F `5BY,X`5D := NOTHING; X END ELSE X IF F `5BY-1,X`5D = NOTHING THEN X BEGIN X F `5BY-1,X`5D := SQUAREFLY1; X F `5BY,X`5D := NOTHING; X END X ELSE F `5BY,X`5D := SQUAREFLY2; X SQUAREFLY2: X IF F `5BY-1,X`5D = NOTHING THEN X BEGIN X F `5BY-1,X`5D := SQUAREFLY1; X F `5BY,X`5D := NOTHING; X END ELSE X IF F `5BY,X+1`5D = NOTHING THEN X BEGIN X F `5BY,X+1`5D := SQUAREFLY2; X F `5BY,X`5D := NOTHING; X END X ELSE F `5BY,X`5D := SQUAREFLY3; X SQUAREFLY3: X IF F `5BY,X+1`5D = NOTHING THEN X BEGIN X F `5BY,X+1`5D := SQUAREFLY2; X F `5BY,X`5D := NOTHING; X END ELSE X IF F `5BY+1,X`5D = NOTHING THEN X BEGIN X F `5BY+1,X`5D := SQUAREFLY3; X F `5BY,X`5D := NOTHING; X END X ELSE F `5BY,X`5D := SQUAREFLY0; X SMASH0: X BEGIN X F `5BY ,X `5D := SMASH1; X IF NOT (F `5BY+1,X `5D IN SETWAYBOR) THEN F `5BY+1,X `5D := SMASH1 V; X IF NOT (F `5BY-1,X `5D IN SETWAYBOR) THEN F `5BY-1,X `5D := SMASH1 V; X IF NOT (F `5BY ,X+1`5D IN SETWAYBOR) THEN F `5BY ,X+1`5D := SMASH1 V; X IF NOT (F `5BY+1,X+1`5D IN SETWAYBOR) THEN F `5BY+1,X+1`5D := SMASH1 V; X IF NOT (F `5BY-1,X+1`5D IN SETWAYBOR) THEN F `5BY-1,X+1`5D := SMASH1 V; X IF NOT (F `5BY ,X-1`5D IN SETWAYBOR) THEN F `5BY ,X-1`5D := SMASH1 V; X IF NOT (F `5BY+1,X-1`5D IN SETWAYBOR) THEN F `5BY+1,X-1`5D := SMASH1 V; X IF NOT (F `5BY-1,X-1`5D IN SETWAYBOR) THEN F `5BY-1,X-1`5D := SMASH1 V; X END; X SMASH1: X F `5BY,X`5D := SMASH2; X SMASH2: X F `5BY,X`5D := SMASH3; X SMASH3: X F `5BY,X`5D := LYINGDIAMONT; X CRASH0: X BEGIN X F `5BY ,X `5D := CRASH1; X IF NOT (F `5BY+1,X `5D IN SETWAYBOR) THEN F `5BY+1,X `5D := CRASH1 V; X IF NOT (F `5BY-1,X `5D IN SETWAYBOR) THEN F `5BY-1,X `5D := CRASH1 V; X IF NOT (F `5BY ,X+1`5D IN SETWAYBOR) THEN F `5BY ,X+1`5D := CRASH1 V; X IF NOT (F `5BY+1,X+1`5D IN SETWAYBOR) THEN F `5BY+1,X+1`5D := CRASH1 V; X IF NOT (F `5BY-1,X+1`5D IN SETWAYBOR) THEN F `5BY-1,X+1`5D := CRASH1 V; X IF NOT (F `5BY ,X-1`5D IN SETWAYBOR) THEN F `5BY ,X-1`5D := CRASH1 V; X IF NOT (F `5BY+1,X-1`5D IN SETWAYBOR) THEN F `5BY+1,X-1`5D := CRASH1 V; X IF NOT (F `5BY-1,X-1`5D IN SETWAYBOR) THEN F `5BY-1,X-1`5D := CRASH1 V; X END; X CRASH1: X F `5BY,X`5D := CRASH2; X CRASH2: X F `5BY,X`5D := CRASH3; X CRASH3: X F `5BY,X`5D := NOTHING; X LIVINGWALL: X IF LW_ACTIVE <= 0 THEN F `5BY,X`5D := SLEEPINGWALL; X SLEEPINGWALL: X IF LW_ACTIVE > 0 THEN F `5BY,X`5D := LIVINGWALL; X END; XIF MAGMA_SURROUNDED THEN MAGMA_CLOSED := TRUE; XIF L_STAT = L_ALIVE THEN X IF (F `5BHAM_B,HAM_A`5D = SMASH1) OR X (F `5BHAM_B,HAM_A`5D = CRASH1) THEN L_STAT := L_DEAD; XIF L_STAT = L_ALIVE THEN X BEGIN X WENT := FALSE; X CASE F `5BHAM_B+HAMPB,HAM_A+HAMPA`5D OF X NOTHING,EARTH: X WENT := TRUE; X WAYOUT: X IF GO THEN X IF HAVE_DIAM >= NEED_DIAM THEN X BEGIN X F `5BHAM_B,HAM_A`5D := NOTHING; X HAM_A := HAM_A + HAMPA; X HAM_B := HAM_B + HAMPB; X L_STAT := L_COUNT; X WINNY := TRUE; X END; X LYINGSTONE: X IF HAMPB=0 THEN X IF CYCLE4=0 THEN X IF F `5BHAM_B,HAM_A+HAMPA+HAMPA`5D = NOTHING THEN X BEGIN X F `5BHAM_B,HAM_A+HAMPA+HAMPA`5D := LYINGSTONE; X WENT := TRUE; X END; X LYINGDIAMONT: X BEGIN X WENT := TRUE; X IF HAVE_DIAM < NEED_DIAM THEN INCSCORE (VAL0_DIAM) X ELSE INCSCORE (VAL1_DIAM); X HAVE_DIAM := HAVE_DIAM+1; X OUTCHR (CHR (7)); X IF HAVE_DIAM = NEED_DIAM THEN X BEGIN X OUTSTR (XXEIN01); X OUTIT; X END; X END; X END; X IF WENT THEN X IF GO THEN X BEGIN X F `5BHAM_B,HAM_A`5D := NOTHING; X HAM_A := HAM_A + HAMPA; X HAM_B := HAM_B + HAMPB; X F `5BHAM_B,HAM_A`5D := HAMSTER; X END X ELSE F `5BHAM_B+HAMPB,HAM_A+HAMPA`5D := NOTHING; X END; XIF L_STAT = L_ALIVE THEN X BEGIN X IF (`5BF `5BHAM_B,HAM_A+1`5D,F `5BHAM_B,HAM_A-1`5D,F `5BHAM_B+1,HAM_A`5D,F V `5BHAM_B-1,HAM_A`5D`5D X * `5BSQUAREFLY0..SQUAREFLY3`5D) <> `5B`5D THEN X BEGIN X F `5BHAM_B,HAM_A`5D := CRASH0; X L_STAT := L_DEAD; X END ELSE X IF (`5BF `5BHAM_B,HAM_A+1`5D,F `5BHAM_B,HAM_A-1`5D,F `5BHAM_B+1,HAM_A`5D,F V `5BHAM_B-1,HAM_A`5D`5D X * `5BBUTTERFLY0..BUTTERFLY3`5D) <> `5B`5D THEN X BEGIN X F `5BHAM_B,HAM_A`5D := SMASH0; X L_STAT := L_DEAD; X END; X END; XIF L_STAT = L_ALIVE THEN X IF F `5BHAM_B-1,HAM_A`5D IN `5BROLLINGSTONE,ROLLINGDIAMONT`5D THEN X BEGIN X F `5BHAM_B,HAM_A`5D := CRASH0; X L_STAT := L_DEAD; X END ELSE X IF O `5BHAM_B-1,HAM_A`5D IN `5BROLLINGSTONE,ROLLINGDIAMONT`5D THEN X BEGIN X F `5BHAM_B,HAM_A`5D := CRASH0; X L_STAT := L_DEAD; X END; XIF L_STAT = L_ALIVE THEN X IF (LEFT_TIME = 0) AND NOT WIZARD THEN X BEGIN X F `5BHAM_B,HAM_A`5D := CRASH0; X L_STAT := L_DEAD; X END; XIF WIZARD THEN XBEGIN X F `5BHAM_B,HAM_A`5D := HAMSTER; X IF L_STAT = L_DEAD THEN L_STAT := L_ALIVE; X IF DOITTOO THEN`20 X IF F `5BHAM_B+HAMPB,HAM_A+HAMPA`5D = LYINGSTONE THEN`20 X F `5BHAM_B+HAMPB,HAM_A+HAMPA`5D := NOTHING; X IF DOIT THEN X IF NOT (F `5BHAM_B+HAMPB,HAM_A+HAMPA`5D IN SETWAYBOR) THEN`20 X IF NOT (F `5BHAM_B+2*HAMPB,HAM_A+2*HAMPA`5D IN SETWAYBOR) THEN`20 X F `5BHAM_B+2*HAMPB,HAM_A+2*HAMPA`5D := CRASH0; X DOIT:=FALSE; XEND; XEND; X`20 XPROCEDURE INIT_PROG; X(* DO INITIALIZE PROGRAM *) X`20 XCONST VT200 = 110; X VT300 = 112; X`20 XVAR LINE:STRING; X I:INTEGER; X C:CHAR; X THI:THING; X HELP:T_CAVE_NAMES; X DEV_RESULT:RECORD X CLASS,TYP:`5BBYTE`5D0..255; X SIZE:`5BWORD`5D0..65535; X BTC1,BTC2,BTC3,PLEN:`5BBYTE`5D0..255; X EXTTC:UNSIGNED; X END; X IOSB:`5BQUAD`5DRECORD X IOSTAT,BUF_LEN,TERM_LEN,TERMINATOR:`5BWORD`5D0..65535; X END; X`20 XBEGIN X$ASSIGN ('SYS$OUTPUT',CHOUT); X$ASSIGN ('SYS$INPUT',CHIN); X$QIOW (CHAN:=CHOUT,FUNC:=IO$_SENSEMODE,IOSB:=IOSB,P1:=DEV_RESULT,P2:=12); XIF NOT ((DEV_RESULT.TYP IN `5BVT200`5D) OR (DEV_RESULT.TYP IN `5BVT300`5D)) V THEN X ERROR ('terminal device mode must be VT200 or VT300. '); XWIDTH := (DEV_RESULT.SIZE-1) DIV 4-1; XHEIGHT := (DEV_RESULT.PLEN-2) DIV 2-1; XOUTINX := 0; XTIMER.HI := -1; XIS_FLASH := '0'; XDOPLAY := 0; XSCORE := 0; XPREDCYC4 `5B0`5D := 1; XPREDCYC4 `5B1`5D := 2; XPREDCYC4 `5B2`5D := 3; XPREDCYC4 `5B3`5D := 0; XRANDOMIZE; XOPEN (DATF,'B$DASH_IN',HISTORY:=READONLY); XRESET (DATF); XREADLN (DATF,CAVEROOT); XREADLN (DATF,GAMEFONT200); XREADLN (DATF,GAMEFONT300); XREADLN (DATF,TASTE_LINX,TASTE_REXZ,TASTE_OBEN,TASTE_UNTN, X SCHAU_LINX,SCHAU_REXZ,SCHAU_OBEN,SCHAU_UNTN); XIF (`5BTASTE_LINX,TASTE_REXZ,TASTE_OBEN,TASTE_UNTN, X SCHAU_LINX,SCHAU_REXZ,SCHAU_OBEN,SCHAU_UNTN`5D * `5B' ','O'..'R'`5D) X <> `5B`5D THEN ERROR ('key defined twice (QRPO ).'); XCLOSE (DATF); XIF (DEV_RESULT.TYP IN `5BVT300`5D) THEN X OPEN (DATF,GAMEFONT300,HISTORY:=READONLY) XELSE X OPEN (DATF,GAMEFONT200,HISTORY:=READONLY); XRESET (DATF); XWHILE NOT EOF (DATF) DO X BEGIN X READLN (DATF,LINE); X OUTSTR (LINE); X END; XCLOSE (DATF); XOPEN (DATF,CAVEROOT,HISTORY:=READONLY); XRESET (DATF); XREADLN (DATF,MAXCAVE); XCAVE_NAMES := NIL; XFOR I := 1 TO MAXCAVE DO X BEGIN X IF EOF (DATF) THEN ERROR ('wrong number of caves.'); X HELP := CAVE_NAMES; X NEW (CAVE_NAMES); X CAVE_NAMES`5E.NEXT := HELP; X READLN (DATF); X READLN (DATF,CAVE_NAMES`5E.NAME); X REPEAT READLN (DATF,C); UNTIL EOF (DATF) OR (C = 'X'); X END; XPICTURE `5B0,NOTHING`5D := 32; XPICTURE `5B0,WAYOUT`5D := 34; XPICTURE `5B0,BORDER`5D := 36; XPICTURE `5B0,EARTH`5D := 38; XPICTURE `5B0,MAGMA`5D := 40; XPICTURE `5B0,LYINGSTONE`5D := 42; XPICTURE `5B0,ROLLINGSTONE`5D := 42; XPICTURE `5B0,LYINGDIAMONT`5D := 44; XPICTURE `5B0,ROLLINGDIAMONT`5D := 44; XPICTURE `5B0,BUTTERFLY0`5D := 46; XPICTURE `5B0,BUTTERFLY1`5D := 46; XPICTURE `5B0,BUTTERFLY2`5D := 46; XPICTURE `5B0,BUTTERFLY3`5D := 46; XPICTURE `5B0,SQUAREFLY0`5D := 48; XPICTURE `5B0,SQUAREFLY1`5D := 48; XPICTURE `5B0,SQUAREFLY2`5D := 48; XPICTURE `5B0,SQUAREFLY3`5D := 48; XPICTURE `5B0,CRASH0`5D := 50; XPICTURE `5B0,CRASH1`5D := 52; XPICTURE `5B0,CRASH2`5D := 54; XPICTURE `5B0,CRASH3`5D := 56; XPICTURE `5B0,SMASH0`5D := 58; XPICTURE `5B0,SMASH1`5D := 60; XPICTURE `5B0,SMASH2`5D := 62; XPICTURE `5B0,SMASH3`5D := 64; XPICTURE `5B0,NORMALWALL`5D := 66; XPICTURE `5B0,LIVINGWALL`5D := 68; XPICTURE `5B0,SLEEPINGWALL`5D := 66; XPICTURE `5B0,HAMSTER`5D := 74; XPICTURE `5B1`5D := PICTURE `5B0`5D; XPICTURE `5B1,BUTTERFLY0`5D := 72; XPICTURE `5B1,BUTTERFLY1`5D := 72; XPICTURE `5B1,BUTTERFLY2`5D := 72; XPICTURE `5B1,BUTTERFLY3`5D := 72; XPICTURE `5B1,SQUAREFLY0`5D := 70; XPICTURE `5B1,SQUAREFLY1`5D := 70; XPICTURE `5B1,SQUAREFLY2`5D := 70; XPICTURE `5B1,SQUAREFLY3`5D := 70; XPICTURE `5B2`5D := PICTURE `5B0`5D; XPICTURE `5B3`5D := PICTURE `5B1`5D; XFOR THI := NOTHING TO THING_HIGH DO X FLASHPICT `5BTHI`5D := '0'; XFLASHPICT `5BMAGMA`5D := '5'; XFLASHPICT `5BLIVINGWALL`5D := '5'; XEND; X`20 XPROCEDURE PLAY_UP (CAVE,NUMH:INTEGER); X(* LET NUMH TIMES PLAY IN CAVE *) X`20 XPROCEDURE MANEKEN (A,B,C,D:INTEGER); XBEGIN XCASE CYCLE4 OF X 0:PICTURE `5B0,HAMSTER`5D := A; X 1:PICTURE `5B1,HAMSTER`5D := B; X 2:PICTURE `5B2,HAMSTER`5D := C; X 3:PICTURE `5B3,HAMSTER`5D := D; X END; XEND; X`20 XPROCEDURE INIT_UP (VAR AREA:GAME_AREA); X(* INIT WITH GAMEUP *) XVAR X,Y,W,H,N,RAND_PRIV:INTEGER; X D:CHAR; X C:TEXT; X`20 X FUNCTION PRIVR (M:INTEGER) : INTEGER; X BEGIN X RAND_PRIV := (43 * RAND_PRIV + 713) MOD 16777259; X PRIVR := RAND_PRIV MOD M; X END; X`20 X PROCEDURE PUTPIF (D:CHAR; X,Y:INTEGER); X BEGIN X IF (X>=0) AND (X<=SIZ_X) AND (Y>=0) AND (Y<=SIZ_Y) THEN X IF (ORD (D) - ORD (' ')) IN `5BORD (NOTHING) .. ORD (PRED (HAMSTER))`5D V THEN X AREA `5BY,X`5D := THETHING (ORD (D) - ORD (' ')) X ELSE ERROR ('illegal field in cave.') X ELSE ERROR ('coordinate out of range.'); X END; X`20 X PROCEDURE PUTBOX (D:CHAR; X,Y,W,H:INTEGER); X VAR I,J:INTEGER; X BEGIN X FOR I := Y TO Y+H-1 DO X FOR J := X TO X+W-1 DO X PUTPIF (D,J,I); X END; X`20 XBEGIN XFOR Y := 0 TO GAME_SIZE DO X FOR X := 0 TO GAME_SIZE DO X AREA `5BY,X`5D := NOTHING; XRESET (DATF); XREADLN (DATF); XN := CAVE; XWHILE N > 0 DO X BEGIN X READLN (DATF); X READLN (DATF); X REPEAT X READLN (DATF,D); X UNTIL D = 'X'; X N := N-1; X END; XREADLN (DATF,SIZ_X,SIZ_Y,HAM_A,HAM_B,NEED_DIAM,VAL0_DIAM,VAL1_DIAM, X LEFT_TIME,BONUS_HAM,RAND_PRIV,MAGMA_GROW); XREADLN (DATF,CAVE_ID); XSIZ_X := SIZ_X-1; XSIZ_Y := SIZ_Y-1; XIF (SIZ_X > GAME_SIZE) OR (SIZ_Y > GAME_SIZE) THEN X ERROR ('cave too big.'); XREPEAT X READ (DATF,D); X IF NOT (D IN `5B'S','B','F','R','L','X'`5D) THEN ERROR ('unknown cave comm Vand.'); X CASE D OF X 'S':BEGIN X READLN (DATF,D,X,Y); X PUTPIF (D,X,Y); X END; X 'B':BEGIN X READLN (DATF,D,X,Y,W,H); X PUTBOX (D,X,Y,W,H); X END; X 'F':BEGIN X READLN (DATF,D,X,Y,W,H); X PUTBOX (D,X,Y,W,1); X PUTBOX (D,X,Y+H-1,W,1); X PUTBOX (D,X,Y,1,H); X PUTBOX (D,X+W-1,Y,1,H); X END; X 'R':BEGIN X READLN (DATF,D,X,Y,W,H,N); X WHILE N > 0 DO X BEGIN X PUTPIF (D,PRIVR (W)+X,PRIVR (H)+Y); X N := N-1; X END; X END; X 'L':BEGIN X READLN (DATF,D,X,Y,W,H,N); X WHILE N > 0 DO X BEGIN X PUTPIF (D,X,Y); X X := X+W; X Y := Y+H; X N := N-1; X END; X END; X END; XUNTIL D = 'X'; XAREA `5BHAM_B,HAM_A`5D := HAMSTER; XFOR Y := 0 TO SIZ_Y DO X BEGIN X IF AREA `5BY,0`5D <> WAYOUT THEN AREA `5BY,0`5D := BORDER; X IF AREA `5BY,SIZ_X`5D <> WAYOUT THEN AREA `5BY,SIZ_X`5D := BORDER; X END; XFOR X := 1 TO SIZ_X DO X BEGIN X IF AREA `5B0,X`5D <> WAYOUT THEN AREA `5B0,X`5D := BORDER; X IF AREA `5BSIZ_Y,X`5D <> WAYOUT THEN AREA `5BSIZ_Y,X`5D := BORDER; X END; XL_STAT := L_COMIN; XSTATUS_C := 8; XHAVE_DIAM := 0; XCYCLE4 := 1; XPICTURE `5BCYCLE4,HAMSTER`5D := 32; XPOS_A := HAM_A - WIDTH DIV 2; XPOS_B := HAM_B - HEIGHT DIV 2; XIF POS_A > SIZ_X - WIDTH THEN POS_A := SIZ_X - WIDTH; XIF POS_A < 0 THEN POS_A := 0; XIF POS_B > SIZ_Y - HEIGHT THEN POS_B := SIZ_Y - HEIGHT; XIF POS_B < 0 THEN POS_B := 0; XPREPPAGE; XPUTPIC1 (AREA,POS_A,POS_B); XQOS_A := POS_A; +-+-+-+-+-+-+-+- END OF PART 3 +-+-+-+-+-+-+-+-