perm filename SHIP.SIM[SIM,SYS] blob sn#460225 filedate 1979-07-20 generic text, type T, neo UTF8
00010	OPTIONS(/l); options(/s:"libsim[106,346]");
00020	BEGIN
00030	  EXTERNAL CHARACTER PROCEDURE getch;
00040	  EXTERNAL INTEGER PROCEDURE trmop, checkreal, checkint;
00050	  EXTERNAL PROCEDURE echo, abort;
00050	  EXTERNAL CLASS vista;
00055	  external boolean procedure ttywait;
00060	
00070	  beginsimulation: INSPECT NEW vista(78, 19, sysin, sysout, FALSE, 1) DO
00080	  BEGIN
00090	    simulation BEGIN
00100	
00110	      REF (head) ships;
00120	      INTEGER horiz, vertic, u, number, Troopsmoved;
00130	      INTEGER enemies←started;
00140	      INTEGER ships←started, ships←holding, ships←killed;
00150	      INTEGER ARRAY ships←(1:4);
00160	      INTEGER loading, forward, unloading, backing;
00170	      CHARACTER numberchar; TEXT command, buffer24; BOOLEAN blinking;
00180	      REF(ship) thisship; REAL speed, delaytime;
00190	
00200	
00210	      PROCEDURE printshipnumbers;
00220	      BEGIN
00230	        move←the←cursor←to(57,11); outint(ships←started,3);
00240	        move←the←cursor←to(57,12); outint(ships←[loading],3);
00250	        move←the←cursor←to(57,13); outint(ships←[forward],3);
00260	        move←the←cursor←to(57,14); outint(ships←[unloading],3);
00270	        move←the←cursor←to(57,15); outint(ships←[backing],3);
00280	        move←the←cursor←to(57,16); outint(ships←holding,3);
00290	        move←the←cursor←to(57,17); outint(ships←killed,3);
00300	      END;
00310	
00320	      PROCEDURE release←Troops;
00330	      BEGIN
00340	        Troopsmoved:= Troopsmoved+1;
00350	        set←char←on←screen('↑',mod(Troopsmoved-1,10)+65,
00360	        1+(Troopsmoved-1)//10);
00370	      END;
00380	
00390	
00400	      process CLASS ship(basicspeed); REAL basicspeed;
00410	      BEGIN
00420	        CHARACTER numberchar; INTEGER horiz, vertic, number, stage;
00430	        BOOLEAN killed, holding; REAL delaytime,speed;
00440	
00450	        PROCEDURE printspeed(speed); REAL speed;
00460	        IF NOT killed THEN
00470	        BEGIN
00480	          move←the←cursor←to(11,vertic);
00490	          outtext("SPEED"); outfix(speed,1,5);
00500	        END;
00510	
00520	        PROCEDURE timedelay(normaldelay); REAL normaldelay;
00530	        BEGIN
00540	          IF killed THEN GOTO ship←termination;
00550	          hold(normaldelay); IF killed THEN GOTO ship←termination;
00560	          IF delaytime > 0.0 THEN
00570	          BEGIN
00580	            hold(delaytime);
00590	            IF killed THEN GOTO ship←termination;
00600	            ships←[stage]:= ships←[stage]+1; holding:= FALSE;
00610	            delaytime:= 0.0;
00620	            printspeed(speed);
00630	            ships←holding:= ships←holding-1; printshipnumbers;
00640	          END;
00650	        END;
00660	
00670	        PROCEDURE randomspeed;
00680	        IF u NE 0 THEN COMMENT random ship speed;
00690	        BEGIN
00700	          speed:= sign(speed)*basicspeed*uniform(0.9,1.1,u);
00710	          printspeed(speed);
00720	        END;
00730	
     			speed:= basicspeed;
00740	        into(ships);
00750	        ships←started:= ships←started+1;
00760	        ships←[forward]:= ships←[forward]+1; stage:= forward;
00770	
00780	        printshipnumbers;
00790	        number:= ships←started;
00800	        numberchar:= char(rank('0')+number);
00810	        horiz:= 24; vertic:= number-1;
00820	        move←the←cursor←to(0,number-1); outtext("SHIP NO ");
00830	        outchar(numberchar); outtext(", SPEED");
00840	        printspeed(speed);
00850	        forwardloop:
00860	        set←char←on←screen(numberchar, horiz, vertic);
00870	        randomspeed; timedelay(1/speed);
00880	        IF horiz < 60 THEN
00890	        BEGIN
00900	          set←char←on←screen(' ', horiz, vertic);
00910	          horiz:= horiz+1;
00920	          GOTO forwardloop;
00930	        END;
00940	        timedelay(1/speed);
00950	        ships←[forward]:= ships←[forward]-1;
00960	        ships←[unloading]:= ships←[unloading]+1; stage:= unloading;
00970	        printshipnumbers;
00980	        move←the←cursor←to(11,vertic); outtext("UNLOADING ");
00990	        timedelay(3.0);
01000	        release←Troops;
01010	        speed:= -speed; printspeed(speed);
01020	        ships←[unloading]:= ships←[unloading]-1;
01030	        ships←[backing]:= ships←[backing]+1; stage:= backing;
01040	        printshipnumbers;
01050	        backloop:
01060	        set←char←on←screen(numberchar, horiz, vertic);
01070	        randomspeed; timedelay(abs(1/speed));
01080	        IF horiz > 24 THEN
01090	        BEGIN
01100	          set←char←on←screen(' ', horiz, vertic);
01110	          horiz:= horiz-1;
01120	          GOTO backloop;
01130	        END;
01140	        IF NOT killed THEN
01150	        BEGIN
01160	          ships←[backing]:= ships←[backing]-1;
01170	          ships←[loading]:= ships←[loading]+1; stage:= loading;
01180	          printshipnumbers;
01190	          move←the←cursor←to(11,vertic); outtext("LOADING   ");
01200	          timedelay(3.0);
01210	          ships←[loading]:= ships←[loading]-1;
01220	          ships←[forward]:= ships←[forward]+1; stage:= forward;
01230	          printshipnumbers;
01240	          speed:= -speed; printspeed(speed); GOTO forwardloop;
01250	          ships←[loading]:= ships←[loading]-1;
01260	          ships←[forward]:= ships←[forward]+1;
01270	          printshipnumbers;
01280	        END;
01290	        ship←termination:
01300	      END of ship;
01310	
01320	      process CLASS DESTROYER(speed); REAL speed;
01330	      BEGIN
01340	        INTEGER horiz, vertic; BOOLEAN up;
01350	        horiz:= 40+enemies←started*2;
01360	        enemies←started:= enemies←started+1;
01370	        WHILE TRUE DO
01380	        BEGIN
01390	          IF get←char←from←screen(horiz, vertic) NE ' ' THEN kill(findship(vertic+1));
01400	          set←char←on←screen('&',horiz,vertic);
01410	          hold(1/speed);
01420	          IF up AND vertic = 0 THEN up:= FALSE ELSE
01430	          IF vertic >= ships←started-1 THEN up:= TRUE;
01440	          IF get←char←from←screen(horiz,vertic) = '&' THEN
01450	          set←char←on←screen(' ',horiz,vertic) ELSE GOTO out;
01460	          if ships←started > 1 then vertic:= vertic + (IF up THEN -1 ELSE 1);
01470	        END;
01480	        out: set←char←on←screen('v',horiz,9);
     	bigbang('v',horiz,vertic);
01490	      END;
01500	
     	process CLASS second←tick;
     	begin
     	integer minutes,seconds; text secarea;
     	secarea:- blanks(3);
     	while true do
     	begin
     	seconds:= entier(time); minutes:= seconds//60;
     	seconds:= mod(seconds,60);
     	secarea.putint(seconds+100);
     	move←the←cursor←to(71,8); outint(minutes,2); outchar(':');
     	outtext(secarea.sub(2,2));
     	hold(1.0);
     	if ttywait(300) then reactivate main;
     	end;
     	end of second←tick;
     	
01510	      process CLASS real←time←delay;
01520	      WHILE u = 0 and ships←started+enemies←started < 9 DO
01530	      BEGIN
01540	        hold(0.25);
01550	        IF horizontalpos NE 0 OR verticalpos NE 0 THEN
01560	        cause←real←time←delay(50);
01570	      END;
01580	
01590	
01600	      PROCEDURE kill(doomed);
01610	      REF (ship) doomed;
01620	      INSPECT doomed WHEN ship DO
01630	      BEGIN
01640	        out; killed:= TRUE;
01650	        set←char←on←screen(' ',horiz,vertic);
01660	        move←the←cursor←to(11,number-1);
01670	        outtext("KILLED     ");
01680	        ships←killed:= ships←killed+1;
01690	        IF NOT holding THEN ships←[stage]:= ships←[stage]-1
01700	        ELSE ships←holding:= ships←holding-1;
01710	        printshipnumbers;
     	bigbang('*',horiz,vertic);
01720	      END;
01730	
     	PROCEDURE bigbang(light,horiz,vertic);
     	character light; integer horiz, vertic;
     	begin
     	CHARACTER array around[-2:2,-1:1];
     	INTEGER i, j;
     	FOR i:=-2 step 1 until 2 DO
     	FOR j:= -1 step 1 until 1 DO
     	IF vertic + j >= 0 THEN around[i,j]:= get←char←from←screen(i+horiz, j+vertic);
     	options(/-w);
     	for j:= vertic-1 step 1 until vertic+1 DO
     	if j >= 0 then set←char←on←screen(stopblink,horiz+2,j);
     	for j:= vertic-1 step 1 until vertic+1 DO
     	if j >= 0 then
     	for i:= horiz+1 step -1 until horiz-1 DO
     	set←char←on←screen(light,i,j);
     	for j:= vertic-1 step 1 until vertic+1 do
     	if j >= 0 then set←char←on←screen(startblink,horiz-2,j);
     	options(/w);
     	cause←real←time←delay(180);
     	for i:= -2 step 1 until 2 do
     	for j:= -1 step 1 until 1 do
     	if vertic+j >= 0 then set←char←on←screen(around[i,j],i+horiz,j+vertic);
     	end of bigbang;
     	
01740	      REF (ship) PROCEDURE findship(number); INTEGER number;
01750	      BEGIN
01760	        REF(ship) thisship;
01770	        thisship:- ships.first;
01780	        WHILE thisship =/= NONE DO
01790	        BEGIN
01800	          IF thisship.number =  number THEN
01810	          BEGIN
01820	            findship:- thisship;
01830	            GOTO out;
01840	          END;
01850	          thisship:- thisship.suc;
01860	        END;
01870	        out:
01880	      END of findship;
01890	
01900	      BOOLEAN PROCEDURE checkanswer(lc,uc,question,answer,acceptable,
01910	      errmess1,errmess2);
01920	      NAME lc, uc, question, errmess1, errmess2, acceptable, answer;
01930	      REAL answer; BOOLEAN acceptable;
01940	      TEXT lc, uc, question, errmess1, errmess2;
01950	      BEGIN
01960	        BOOLEAN check;
01970	        IF command.length >= lc.length THEN checkanswer:= check:=
01980	        command.sub(1,lc.length) = lc OR command.sub(1,uc.length) = uc;
01990	        IF check THEN
02000	        BEGIN
02010	          IF blinking THEN
02020	          BEGIN
02030	            move←the←cursor←to(horizontalpos,verticalpos+3);
02040	            outtext("                         ");
02061	            outimage;
02062	            outtext("                         ");
02063	            outimage;
02064	            outtext("                         ");
02070	            move←the←cursor←to(horizontalpos,verticalpos-5);
02080	            blinking:= FALSE;
02090	          END;
02100	          IF question.length > 0 THEN
02110	          BEGIN
02120	            outimage; buffer24:= question; outtext(buffer24); outimage;
02130	            answer:= inreal;
02140	            IF NOT acceptable THEN
02150	            BEGIN
02160	              outimage; blinking:= TRUE;
02170	              outchar(startblink); buffer24:= errmess1;
02180	              outtext(buffer24); outimage;
02190	              outchar(startblink); buffer24:= errmess2;
02200	              outtext(buffer24);
02210	              GOTO getcommand;
02220	            END;
02230	          END;
02240	          move←the←cursor←to(0,11); outtext("              ");
02250	        END;
02260	      END of checkanswer;
02270	
02280	      loading:= 1; forward:= 2; unloading:= 3; backing:= 4;
02290	      buffer24:- blanks(24);
02300	      ACTIVATE NEW real←time←delay;
02310	      blank←the←screen; ships:- NEW head;
     	activate new second←tick;
02320	      FOR vertic:= 0 STEP 1 UNTIL 8 DO
02330	      BEGIN
02340	        set←char←on←screen('|',23,vertic);
02350	        set←char←on←screen('|',61,vertic);
02360	      END;
02370	      move←the←cursor←to(65,0); outtext("Troops moved");
     	move←the←cursor←to(65,8); outtext("TIME:  0.00");
02380	      move←the←cursor←to(0,10);
02390	      outtext(
02400	      "Commands -> -> -> -> -> -> START new ship,");
02410	      BEGIN
02420	        PROCEDURE typecommand(t); NAME t; TEXT t;
02430	        BEGIN
02440	          move←the←cursor←to(26,verticalpos+1);
02450	          outchar(stopblink); outtext(t);
02460	        END;
02470	        typecommand("DESTROYER start,");
02480	        typecommand("KILL old ship,"); typecommand("HOLD ship,");
02490	        typecommand("RANDOM ship speed,");
02500	        typecommand("WAIT delay time,");
02510	        typecommand("BEGIN new run,");
     	        typecommand("↑S and ↑Q stop-start,");
02520	        typecommand("<ESC> for bad picture, <RETURN> for interrupt.");
02540	      END;
02550	      move←the←cursor←to(57,10); outtext(" NO OF SHIPS:");
02560	      move←the←cursor←to(61,11); outtext("STARTED");
02570	      move←the←cursor←to(61,12); outtext("LOADING");
02580	      move←the←cursor←to(61,13); outtext("FORWARD");
02590	      move←the←cursor←to(61,14); outtext("UNLOADING");
02600	      move←the←cursor←to(61,15); outtext("BACKING");
02610	      move←the←cursor←to(61,16); outtext("HOLDING");
02620	      move←the←cursor←to(61,17); outtext("KILLED");
02630	      printshipnumbers;
02640	      WHILE TRUE DO
02650	      BEGIN
02660	        getcommand: FOR vertic:= 12 STEP 1 UNTIL 14 DO
02670	        BEGIN
02680	          move←the←cursor←to(0,vertic);
02690	          outtext("                         ");
02700	        END;
02710	        move←the←cursor←to(0,11); outtext("GIVE COMMAND:"); outimage;
02720	        command:- inword;
02730	        IF checkanswer("r","R","start random number:",u,
02740	        u > 0,"must be positive",NOTEXT) THEN ELSE
02750	        IF checkanswer("s","S","Speed of new ship?",
02760	        speed, speed > 0.2 AND speed < 80.0 AND ships←started < 9,
02770	        "0.2 < speed < 80.0","and max 9 ships")
02780	        THEN ACTIVATE NEW ship(speed)
02790	        ELSE IF checkanswer("d","D","Speed of new destroyer?",
02800	        speed, speed > 0.2 AND speed < 80.0 AND enemies←started < 9,
02810	        "0.2 < speed < 80.0","and max 9 destroyers")
02820	        THEN ACTIVATE NEW DESTROYER(speed)
02830	        ELSE IF checkanswer("h","H","Give ship number:",
02840	        number,number >= 1 AND number <= ships←started,
02850	        "No such ship",NOTEXT) THEN
02860	        BEGIN
02870	          INSPECT findship(number) WHEN ship DO
02880	          BEGIN
02890	            holding:= TRUE; ships←[stage]:= ships←[stage]-1;
02900	            ships←holding:= ships←holding+1; printshipnumbers;
02910	            delaytime:= 3.0;
02920	            move←the←cursor←to(11,vertic); outtext("HOLDING   ");
02930	          END;
02940	        END
02950	        ELSE IF checkanswer("b","B",NOTEXT,
02960	        number,TRUE,NOTEXT,NOTEXT) THEN GOTO beginsimulation
02970	        ELSE IF checkanswer("k","K","Give ship number:",
02980	        number,number >= 1 AND number <= ships←started,
02990	        "No such ship",NOTEXT) THEN
03000	        BEGIN
03010	          kill(findship(number));
03020	        END
03030	        ELSE IF checkanswer("w","W",
03040	        "How long time?",delaytime,
03050	        delaytime >= 0 AND delaytime < 500.0,
03060	        "0 <= delay < 500","acceptable")
03070	        THEN
03080	        BEGIN home←the←cursor; echoff; hold(delaytime);
     	          echon;
03090	        END ELSE GOTO getcommand;
03100	      END;
03110	
03120	    END comment simulation;
03130	  END comment inspect vista;
03140	  exit:
03150	END;