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;