Google
 

Trailing-Edge - PDP-10 Archives - decuslib20-04 - decus/20-0135/comp/ship.sim
There are 4 other files named ship.sim in the archive. Click here to see a list.
00050	OPTIONS(/l);
00100	BEGIN
00150	EXTERNAL CHARACTER PROCEDURE insinglechar, fetchar;
00200	EXTERNAL TEXT PROCEDURE storbokstav, scanto, tmpin;
00250	EXTERNAL BOOLEAN PROCEDURE meny; EXTERNAL CLASS termty;
00300	EXTERNAL INTEGER PROCEDURE trmop, gettab, checkreal, checkint, iondx;
00350	EXTERNAL PROCEDURE depchar, forceout, outstring, outchr, echo, abort;
00375	EXTERNAL PROCEDURE outche;
00400	EXTERNAL CLASS vista;
00450	EXTERNAL BOOLEAN PROCEDURE tmpout;
00500	INTEGER termspeed, fillers;
00550	outtext("Input speed of terminal line in baude(default:2400): ");
00600	breakoutimage; inimage;
00650	outchr(sysout,char(12),1); !form feed;
00700	IF sysin.image.strip = NOTEXT THEN termspeed:= 2400 ELSE
00750	termspeed:= inint;
00800	fillers:= (termspeed-400)/40;
00850	IF fillers < 0 THEN fillers:= 0;
00900	
00950	
01000	beginsimulation: INSPECT NEW vista(78, 19, sysin, sysout, FALSE, 0,
01050	NOTEXT, NOTEXT) DO
01100	BEGIN
01150	  simulation BEGIN
01200	
01250	    REF (head) ships;
01300	    INTEGER horiz, vertic, u, number, troopsmoved;
01350	    INTEGER enemies_started;
01400	    INTEGER ships_started, ships_holding, ships_killed;
01450	    INTEGER ARRAY ships_(1:4);
01500	    INTEGER loading, forward, unloading, backing;
01550	    CHARACTER numberchar; TEXT command, buffer24; BOOLEAN blinking;
01600	    REF(ship) thisship; REAL speed, delaytime;
01650	
01700	
01750	    PROCEDURE printshipnumbers;
01800	    BEGIN
01850	      move_the_cursor_to(57,11); outint(ships_started,3);
01900	      move_the_cursor_to(57,12); outint(ships_[loading],3);
01950	      move_the_cursor_to(57,13); outint(ships_[forward],3);
02000	      move_the_cursor_to(57,14); outint(ships_[unloading],3);
02050	      move_the_cursor_to(57,15); outint(ships_[backing],3);
02100	      move_the_cursor_to(57,16); outint(ships_holding,3);
02150	      move_the_cursor_to(57,17); outint(ships_killed,3);
02200	    END;
02250	
02300	    PROCEDURE release_troops;
02350	    BEGIN
02400	      troopsmoved:= troopsmoved+1;
02450	      set_char_on_screen('^',mod(troopsmoved-1,10)+65,
02500	      1+(troopsmoved-1)//10);
02550	    END;
02600	
02650	
02700	    process CLASS ship(basicspeed); REAL basicspeed;
02750	    BEGIN
02800	      CHARACTER numberchar; INTEGER horiz, vertic, number, stage;
02850	      BOOLEAN killed, holding; REAL delaytime,speed;
02900	
02950	      PROCEDURE printspeed(speed); REAL speed;
03000	      IF NOT killed THEN
03050	      BEGIN
03100	        move_the_cursor_to(11,vertic);
03150	        outtext("SPEED"); outfix(speed,1,5);
03200	      END;
03250	
03300	      PROCEDURE timedelay(normaldelay); REAL normaldelay;
03350	      BEGIN
03400	        IF killed THEN GOTO ship_termination;
03450	        hold(normaldelay); IF killed THEN GOTO ship_termination;
03500	        IF delaytime > 0.0 THEN
03550	        BEGIN
03600	          hold(delaytime);
03650	          IF killed THEN GOTO ship_termination;
03700	          ships_[stage]:= ships_[stage]+1; holding:= FALSE;
03750	          delaytime:= 0.0;
03800	          printspeed(speed);
03850	          ships_holding:= ships_holding-1; printshipnumbers;
03900	        END;
03950	      END;
04000	
04050	      PROCEDURE randomspeed;
04100	      IF u NE 0 THEN COMMENT random ship speed;
04150	      BEGIN
04200	        speed:= sign(speed)*basicspeed*uniform(0.9,1.1,u);
04250	        printspeed(speed);
04300	      END;
04350	
04400	      speed:= basicspeed;
04450	      into(ships);
04500	      ships_started:= ships_started+1;
04550	      ships_[forward]:= ships_[forward]+1; stage:= forward;
04600	
04650	      printshipnumbers;
04700	      number:= ships_started;
04750	      numberchar:= char(rank('0')+number);
04800	      horiz:= 24; vertic:= number-1;
04850	      move_the_cursor_to(0,number-1); outtext("SHIP NO ");
04900	      outchar(numberchar); outtext(", SPEED");
04950	      printspeed(speed);
05000	      forwardloop:
05050	      set_char_on_screen(numberchar, horiz, vertic);
05100	      randomspeed; timedelay(1/speed);
05150	      IF horiz < 60 THEN
05200	      BEGIN
05250	        set_char_on_screen(' ', horiz, vertic);
05300	        horiz:= horiz+1;
05350	        GOTO forwardloop;
05400	      END;
05450	      timedelay(1/speed);
05500	      ships_[forward]:= ships_[forward]-1;
05550	      ships_[unloading]:= ships_[unloading]+1; stage:= unloading;
05600	      printshipnumbers;
05650	      move_the_cursor_to(11,vertic); outtext("UNLOADING ");
05700	      timedelay(3.0);
05750	      release_troops;
05800	      speed:= -speed; printspeed(speed);
05850	      ships_[unloading]:= ships_[unloading]-1;
05900	      ships_[backing]:= ships_[backing]+1; stage:= backing;
05950	      printshipnumbers;
06000	      backloop:
06050	      set_char_on_screen(numberchar, horiz, vertic);
06100	      randomspeed; timedelay(abs(1/speed));
06150	      IF horiz > 24 THEN
06200	      BEGIN
06250	        set_char_on_screen(' ', horiz, vertic);
06300	        horiz:= horiz-1;
06350	        GOTO backloop;
06400	      END;
06450	      IF NOT killed THEN
06500	      BEGIN
06550	        ships_[backing]:= ships_[backing]-1;
06600	        ships_[loading]:= ships_[loading]+1; stage:= loading;
06650	        printshipnumbers;
06700	        move_the_cursor_to(11,vertic); outtext("LOADING   ");
06750	        timedelay(3.0);
06800	        ships_[loading]:= ships_[loading]-1;
06850	        ships_[forward]:= ships_[forward]+1; stage:= forward;
06900	        printshipnumbers;
06950	        speed:= -speed; printspeed(speed); GOTO forwardloop;
07000	        ships_[loading]:= ships_[loading]-1;
07050	        ships_[forward]:= ships_[forward]+1;
07100	        printshipnumbers;
07150	      END;
07200	      ship_termination:
07250	    END of ship;
07300	
07350	    process CLASS destroyer(speed); REAL speed;
07400	    BEGIN
07450	      INTEGER horiz, vertic; BOOLEAN up;
07500	      horiz:= 40+enemies_started*2;
07550	      enemies_started:= enemies_started+1;
07600	      WHILE TRUE DO
07650	      BEGIN
07700	        IF get_char_from_screen(horiz, vertic) NE ' ' THEN
07750	        kill(findship(vertic+1));
07800	        set_char_on_screen('&',horiz,vertic);
07850	        hold(1/speed);
07900	        IF up AND vertic = 0 THEN up:= FALSE ELSE
07950	        IF vertic >= ships_started-1 THEN up:= TRUE;
08000	        IF get_char_from_screen(horiz,vertic) = '&' THEN
08050	        set_char_on_screen(' ',horiz,vertic) ELSE GOTO out;
08100	        IF ships_started > 1 THEN vertic:= vertic + (IF up THEN -1
08150	        ELSE 1);
08200	      END;
08250	      out: set_char_on_screen('v',horiz,9);
08300	      bigbang('v',horiz,vertic);
08350	    END;
08400	
08450	    process CLASS second_tick;
08500	    BEGIN
08550	      INTEGER minutes,seconds; TEXT secarea;
08600	      secarea:- blanks(3);
08650	      WHILE TRUE DO
08700	      BEGIN
08750	        seconds:= entier(time); minutes:= seconds//60;
08800	        seconds:= mod(seconds,60);
08850	        secarea.putint(seconds+100);
08900	        move_the_cursor_to(71,8); outint(minutes,2); outchar(':');
08950	        outtext(secarea.sub(2,2));
09000	        hold(1.0);
09025	        ! Check for type ahead from the user;
09050	        IF trmop(8R0001,sysout,1) = 1 THEN reactivate MAIN;
09100	      END;
09150	    END of second_tick;
09200	
09250	    process CLASS real_time_delay;
09300	    WHILE u = 0 AND ships_started+enemies_started < 9 DO
09350	    BEGIN
09400	      hold(0.25);
09450	      IF horizontalpos NE 0 OR verticalpos NE 0 THEN
09500	      cause_real_time_delay(fillers);
09550	    END;
09600	
09650	
09700	    PROCEDURE kill(doomed);
09750	    REF (ship) doomed;
09800	    INSPECT doomed WHEN ship DO
09850	    BEGIN
09900	      out; killed:= TRUE;
09950	      set_char_on_screen(' ',horiz,vertic);
10000	      move_the_cursor_to(11,number-1);
10050	      outtext("KILLED     ");
10100	      ships_killed:= ships_killed+1;
10150	      IF NOT holding THEN ships_[stage]:= ships_[stage]-1
10200	      ELSE ships_holding:= ships_holding-1;
10250	      printshipnumbers;
10300	      bigbang('*',horiz,vertic);
10350	    END;
10400	
10450	    PROCEDURE bigbang(light,horiz,vertic);
10500	    CHARACTER light; INTEGER horiz, vertic;
10550	    BEGIN
10600	      CHARACTER ARRAY around[-2:2,-1:1];
10650	      INTEGER i, j;
10700	      FOR i:=-2 STEP 1 UNTIL 2 DO
10750	      FOR j:= -1 STEP 1 UNTIL 1 DO
10800	      IF vertic + j >= 0 THEN around[i,j]:=
10850	      get_char_from_screen(i+horiz, j+vertic);
10900	      OPTIONS(/-w);
10950	      FOR j:= vertic-1 STEP 1 UNTIL vertic+1 DO
11000	      IF j >= 0 THEN
11050	      BEGIN move_the_cursor_to(horiz+2,j); stop_blink;
11100	      END;
11150	      FOR j:= vertic-1 STEP 1 UNTIL vertic+1 DO
11200	      IF j >= 0 THEN
11250	      BEGIN move_the_cursor_to(horiz-2,j); start_blink;
11300	      END;
11350	      FOR j:= vertic-1 STEP 1 UNTIL vertic+1 DO
11400	      IF j >= 0 THEN
11450	      FOR i:= horiz+1 STEP -1 UNTIL horiz-1 DO
11500	      set_char_on_screen(light,i,j);
11550	      FOR j:= vertic-1 STEP 1 UNTIL vertic+1 DO
11600	      IF j >= 0 THEN
11650	      BEGIN move_the_cursor_to(horiz+2,j); stop_blink;
11700	      END;
11750	      OPTIONS(/w);
11800	      cause_real_time_delay(fillers*4);
11850	      FOR i:= -2 STEP 1 UNTIL 2 DO
11900	      FOR j:= -1 STEP 1 UNTIL 1 DO
11950	      IF vertic+j >= 0 THEN
12000	      set_char_on_screen(around[i,j],i+horiz,j+vertic);
12050	      stop_blink;
12100	    END of bigbang;
12150	
12200	    REF (ship) PROCEDURE findship(number); INTEGER number;
12250	    BEGIN
12300	      REF(ship) thisship;
12350	      thisship:- ships.first;
12400	      WHILE thisship =/= NONE DO
12450	      BEGIN
12500	        IF thisship.number =  number THEN
12550	        BEGIN
12600	          findship:- thisship;
12650	          GOTO out;
12700	        END;
12750	        thisship:- thisship.suc;
12800	      END;
12850	      out:
12900	    END of findship;
12950	
13000	    BOOLEAN PROCEDURE checkanswer(lc,uc,question,answer,acceptable,
13050	    errmess1,errmess2);
13100	    NAME lc, uc, question, errmess1, errmess2, acceptable, answer;
13150	    REAL answer; BOOLEAN acceptable;
13200	    TEXT lc, uc, question, errmess1, errmess2;
13250	    BEGIN
13300	      BOOLEAN check;
13350	      IF command.length >= lc.length THEN checkanswer:= check:=
13400	      command.sub(1,lc.length) = lc OR command.sub(1,uc.length) = uc;
13450	      IF check THEN
13500	      BEGIN
13550	        IF blinking THEN
13600	        BEGIN
13650	          move_the_cursor_to(horizontalpos,verticalpos+3);
13700	          make_blank(25);
13750	          outimage;
13800	          make_blank(25);
13850	          outimage;
13900	          make_blank(25);
13950	          move_the_cursor_to(horizontalpos,verticalpos-5);
14000	          blinking:= FALSE;
14050	        END;
14100	        IF question.length > 0 THEN
14150	        BEGIN
14200	          outimage; buffer24:= question; outtext(buffer24); outimage;
14250	          answer:= inreal;
14300	          IF NOT acceptable THEN
14350	          BEGIN
14400	            outimage; blinking:= TRUE;
14450	            start_blink; buffer24:= errmess1;
14500	            outtext(buffer24); stop_blink; outimage;
14550	            start_blink; buffer24:= errmess2;
14600	            outtext(buffer24); stop_blink;
14650	            GOTO getcommand;
14700	          END;
14750	        END;
14800	        move_the_cursor_to(0,11); make_blank(14);
14850	      END;
14900	    END of checkanswer;
14950	
15000	    loading:= 1; forward:= 2; unloading:= 3; backing:= 4;
15050	    buffer24:- blanks(24);
15100	    ACTIVATE NEW real_time_delay;
15150	    blank_the_screen; ships:- NEW head;
15200	    ACTIVATE NEW second_tick;
15250	    FOR vertic:= 0 STEP 1 UNTIL 8 DO
15300	    BEGIN
15350	      set_char_on_screen('!',23,vertic);
15400	      set_char_on_screen('!',61,vertic);
15450	    END;
15500	    move_the_cursor_to(65,0); outtext("Troops moved");
15550	    move_the_cursor_to(65,8); outtext("TIME:  0.00");
15600	    move_the_cursor_to(0,10);
15650	    outtext(
15700	    "Commands -> -> -> -> -> -> START new ship,");
15750	    BEGIN
15800	      PROCEDURE typecommand(t); NAME t; TEXT t;
15850	      BEGIN
15900	        move_the_cursor_to(26,verticalpos+1);
15950	        stop_blink; outtext(t);
16000	      END;
16050	      typecommand("DESTROYER start,");
16100	      typecommand("KILL old ship, HOLD ship,");
16150	      typecommand("RANDOM ship speed,");
16200	      typecommand("WAIT delay time,");
16250	      typecommand("BEGIN new run,");
16300	      typecommand("^S and ^Q stop-start,");
16350	      typecommand("<RETURN> for interrupt,");
16375	      typecommand("<CLEAR> or <ERASE> to restore bad screen.");
16400	    END;
16450	    move_the_cursor_to(57,10); outtext(" NO OF SHIPS:");
16500	    move_the_cursor_to(61,11); outtext("STARTED");
16550	    move_the_cursor_to(61,12); outtext("LOADING");
16600	    move_the_cursor_to(61,13); outtext("FORWARD");
16650	    move_the_cursor_to(61,14); outtext("UNLOADING");
16700	    move_the_cursor_to(61,15); outtext("BACKING");
16750	    move_the_cursor_to(61,16); outtext("HOLDING");
16800	    move_the_cursor_to(61,17); outtext("KILLED");
16850	    printshipnumbers;
16900	    WHILE TRUE DO
16950	    BEGIN
17000	      getcommand: FOR vertic:= 12 STEP 1 UNTIL 14 DO
17050	      BEGIN
17100	        move_the_cursor_to(0,vertic);
17150	        make_blank(25);
17200	      END;
17250	      move_the_cursor_to(0,11); outtext("GIVE COMMAND:"); outimage;
17300	      command:- inword;
17350	      IF checkanswer("r","R","start random number:",u,
17400	      u > 0,"must be positive",NOTEXT) THEN ELSE
17450	      IF checkanswer("s","S","Speed of new ship?",
17500	      speed, speed > 0.2 AND speed < 80.0 AND ships_started < 9,
17550	      "0.2 < speed < 80.0","and max 9 ships")
17600	      THEN ACTIVATE NEW ship(speed)
17650	      ELSE IF checkanswer("d","D","Speed of new destroyer?",
17700	      speed, speed > 0.2 AND speed < 80.0 AND enemies_started < 9,
17750	      "0.2 < speed < 80.0","and max 9 destroyers")
17800	      THEN ACTIVATE NEW destroyer(speed)
17850	      ELSE IF checkanswer("h","H","Give ship number:",
17900	      number,number >= 1 AND number <= ships_started,
17950	      "No such ship",NOTEXT) THEN
18000	      BEGIN
18050	        INSPECT findship(number) WHEN ship DO
18100	        BEGIN
18150	          holding:= TRUE; ships_[stage]:= ships_[stage]-1;
18200	          ships_holding:= ships_holding+1; printshipnumbers;
18250	          delaytime:= 3.0;
18300	          move_the_cursor_to(11,vertic); outtext("HOLDING   ");
18350	        END;
18400	      END
18450	      ELSE IF checkanswer("b","B",NOTEXT,
18500	      number,TRUE,NOTEXT,NOTEXT) THEN
18550	      BEGIN blank_the_screen;  GOTO beginsimulation
18600	      END ELSE IF checkanswer("k","K","Give ship number:",
18650	      number,number >= 1 AND number <= ships_started,
18700	      "No such ship",NOTEXT) THEN
18750	      BEGIN
18800	        kill(findship(number));
18850	      END
18900	      ELSE IF checkanswer("w","W",
18950	      "How long time?",delaytime,
19000	      delaytime >= 0 AND delaytime < 500.0,
19050	      "0 <= delay < 500","acceptable")
19100	      THEN
19150	      BEGIN home_the_cursor; hold(delaytime);
19200	      END ELSE GOTO getcommand;
19250	    END;
19300	
19350	  END comment simulation;
19400	END comment inspect vista;
19450	exit:
19500	END;