module
22
An answer to every exercise in the primer, each of them compiled and run on the machine. Yours does not have to match. If it does what the exercise asked, it is right.
Try the exercise first. A solution you have read is a great deal less use than one you have fought for.
The programs are shown as you type them into XBAS, with line numbers.
3.1 In XBAS, type AUTO, then the four lines - XBAS numbers them 10 to 40 - and ENTER on the 50 it offers:
AUTO
PROGRAM NAME;
BEGIN
WRITELN('ADA')
END.
XBAS answers Branch Error and Ready. Then SAVE "NAME.ASC".
3.2 After LOAD "FIRST.ASC", type 15 (* LINE 15 *), 25 (* LINE 25 *) and so on up to 75. RENUM, then LIST: the fifteen lines are now numbered 10, 20, 30 ... 150, the old and new lines in their places.
4.1 DOS, then HPEIN NAME, then NAME. It prints ADA.
4.2 Give the new name first:
HPEIN TWENTY FIRST
TWENTY
TWENTY prints 20.
5.1
10 PROGRAM FOREVER;
20 VAR N:INTEGER;
30 BEGIN
40 N:=0;
50 REPEAT
60 N:=N+1;
70 WRITELN(N)
80 UNTIL FALSE
90 END.
It counts up the screen until CTRL-C: Halt at PC=0E74. The listing has line 60 at 0E71 and line 70 at 0E7B, so the address is in line 60 - the first line inside the REPEAT, where the check for CTRL-C is made.
5.2 The ten numbers take about 21 seconds with the check and under a second without it. 30,000 passes of the empty loop in 20.9 seconds is about 1,440 a second; in 0.74 seconds, about 40,000 a second.
6.1
10 PROGRAM SQUARES;
20 VAR I:INTEGER;
30 BEGIN
40 FOR I:=1 TO 10 DO
50 WRITELN(I:2,I*I:5)
60 END.
The widths keep the columns straight and leave no space at the ends:
1 1
2 4
...
10 100
6.2
10 PROGRAM HEXES;
20 BEGIN
30 WRITELN(1000:4:H);
40 WRITELN(4096:4:H);
50 WRITELN(32767:4:H)
60 END.
prints 03E8, 1000 and 7FFF.
6.3
10 PROGRAM ROUNDS;
20 BEGIN
30 WRITELN(ROUND(3.5),TRUNC(3.5),ENTIER(3.5));
40 WRITELN(ROUND(-3.5),TRUNC(-3.5),ENTIER(-3.5));
50 WRITELN(ROUND(-3.4),TRUNC(-3.4),ENTIER(-3.4))
60 END.
4 3 3
-3 -3 -4
-3 -3 -4
For positive numbers TRUNC and ENTIER agree; for negative ones ENTIER goes one further down.
7.1 No - both names start HIGHSCOR:
10 PROGRAM SCORES;
20 VAR HIGHSCORE,HIGHSCORETODAY:INTEGER;
30 BEGIN
40 HIGHSCORE:=100;
50 HIGHSCORETODAY:=5;
60 WRITELN(HIGHSCORE)
70 END.
prints 5. Call the second one TODAYSHIGH.
8.1
10 PROGRAM BACKWARD;
20 TYPE WORD=ARRAY[1..8] OF CHAR;
30 VAR W:WORD;
40 PROCEDURE BACK(VAR S:WORD);
50 VAR I:INTEGER;
60 BEGIN
70 FOR I:=8 DOWNTO 1 DO
80 IF S[I]<>CHR(0) THEN WRITE(S[I]);
90 WRITELN
100 END;
110 BEGIN
120 WRITE('WORD',CHR(63),' ');
130 READLN;
140 READ(W);
150 BACK(W)
160 END.
EINSTEIN comes back as NIETSNIE.
8.2 Small letters are 32 codes above their capitals, and 97 to 122 is a to z. The small letters have to come from the keyboard - XBAS would turn any typed into the program into capitals - so the program reads two words and compares them:
10 PROGRAM SAMEWORD;
20 TYPE WORD=ARRAY[1..8] OF CHAR;
30 VAR X,Y:WORD;
40 FUNCTION SAME(A,B:WORD):BOOLEAN;
50 VAR I:INTEGER; OK:BOOLEAN;
60 BEGIN
70 OK:=TRUE;
80 FOR I:=1 TO 8 DO
90 BEGIN
100 IF (A[I]>=CHR(97)) AND (A[I]<=CHR(122)) THEN
110 A[I]:=CHR(ORD(A[I])-32);
120 IF (B[I]>=CHR(97)) AND (B[I]<=CHR(122)) THEN
130 B[I]:=CHR(ORD(B[I])-32);
140 IF A[I]<>B[I] THEN OK:=FALSE
150 END;
160 SAME:=OK
170 END;
180 BEGIN
190 WRITE('FIRST',CHR(63),' ');
200 READLN; READ(X);
210 WRITE('SECOND',CHR(63),' ');
220 READLN; READ(Y);
230 WRITELN(SAME(X,Y))
240 END.
EINSTEIN and then Einstein (CAPS LOCK pressed for the second) give TRUE; two different words, FALSE.
9.1
10 PROGRAM MINUTES;
20 VAR S:INTEGER;
30 BEGIN
40 WRITE('SECONDS',CHR(63),' ');
50 READ(S);
60 WRITELN(S DIV 60,'MINUTES ',S MOD 60,'SECONDS')
70 END.
125 gives 2 MINUTES 5 SECONDS.
9.2
10 PROGRAM REPEATS;
20 TYPE WORD=ARRAY[1..8] OF CHAR;
30 VAR W:WORD; N,I:INTEGER;
40 BEGIN
50 WRITE('WORD',CHR(63),' ');
60 READLN;
70 READ(W);
80 WRITE('HOW MANY',CHR(63),' ');
90 READ(N);
100 FOR I:=1 TO N DO WRITE(W,' ');
110 WRITELN
120 END.
HELLO and 3 give HELLO HELLO HELLO.
10.1 LIST shows a line 601 :WRITE('LEFT'); near the end, and no line 60. XBAS read the 1 of the label as part of the line number.
10.2
10 PROGRAM ADDUP;
20 FUNCTION SUM(N:INTEGER):INTEGER;
30 BEGIN
40 IF N=0 THEN SUM:=0
50 ELSE SUM:=N+SUM(N-1)
60 END;
70 BEGIN
80 WRITELN(SUM(100))
90 END.
prints 5050, a hundred calls deep, with no option needed.
11.1 Add WHITE to the type, give the ink [WHITE], and - the part that is easy to miss - change the FOR in line 220 to run RED TO WHITE:
20 TYPE COLOUR=(RED,GREEN,BLUE,WHITE);
150 S[3].NAME:='INK '; S[3].HUES:=[WHITE];
220 FOR C:=RED TO WHITE DO
The ink's line now ends 3.
11.2
10 PROGRAM BLUES;
20 TYPE COLOUR=(RED,GREEN,BLUE);
30 ITEM=RECORD
40 NAME:ARRAY[1..5] OF CHAR;
50 HUES:SET OF COLOUR;
60 COUNT:1..99
70 END;
80 SHELVES=ARRAY[1..3] OF ITEM;
90 VAR S:SHELVES;
100 PROCEDURE COUNTBLUE(VAR SH:SHELVES);
110 VAR I,N:INTEGER;
120 BEGIN
130 N:=0;
140 FOR I:=1 TO 3 DO
150 IF BLUE IN SH[I].HUES THEN N:=N+1;
160 WRITELN(N,'WITH BLUE')
170 END;
180 BEGIN
190 S[1].HUES:=[RED,BLUE];
200 S[2].HUES:=[GREEN];
210 S[3].HUES:=[];
220 COUNTBLUE(S)
230 END.
prints 1 WITH BLUE.
12.1 Two programs. The first writes a spare line and then the numbers:
10 PROGRAM SAVENUM;
20 VAR F:TEXT; I,N:INTEGER;
30 BEGIN
40 REWRITE(F,'A:NUMBERS .TXT');
50 WRITELN(F,'(SPARE LINE)');
60 FOR I:=1 TO 5 DO
70 BEGIN
80 WRITE('NUMBER',CHR(63),' ');
90 READ(N);
100 WRITELN(F,N)
110 END
120 END.
The second reads them with a big buffer, skipping the spare line:
10 PROGRAM ADDNUM;
20 VAR F:TEXT[8]; I,N,T:INTEGER;
30 BEGIN
40 RESET(F,'A:NUMBERS .TXT');
50 READLN(F);
60 T:=0;
70 FOR I:=1 TO 5 DO
80 BEGIN READ(F,N); T:=T+N END;
90 WRITELN('TOTAL ',T)
100 END.
10, 20, 30, 40, 5 give TOTAL 105.
12.2 Test EOF straight after the RESET - replace lines 40 to 150 of SHOW with:
40 RESET(F,'A:NOTES .TXT');
50 IF EOF(F) THEN WRITELN('NO NOTES')
60 ELSE
70 BEGIN
80 READLN(F);
90 N:=0;
100 WHILE NOT EOF(F) DO
110 BEGIN
120 WHILE NOT EOLN(F) DO
130 BEGIN READ(F,C); WRITE(C) END;
140 READLN(F); WRITELN;
150 N:=N+1
160 END;
170 WRITELN(N,'LINES')
180 END
190 END.
On a disc without NOTES.TXT it says NO NOTES; after NOTES has run, it lists the thirty lines as before.
13.1
10 PROGRAM REVERSE;
20 TYPE NODE=RECORD V:INTEGER; NEXT:^NODE END;
30 LINK=^NODE;
40 VAR TOP,P:LINK; N:INTEGER;
50 BEGIN
60 TOP:=NIL;
70 REPEAT
80 READ(N);
90 IF N<>0 THEN
100 BEGIN
110 NEW(P); P^.V:=N; P^.NEXT:=TOP; TOP:=P
120 END
130 UNTIL N=0;
140 P:=TOP;
150 WHILE P<>NIL DO
160 BEGIN WRITE(P^.V); P:=P^.NEXT END;
170 WRITELN
180 END.
1 2 3 4 0 gives 4 3 2 1.
13.2 Wrap it in a loop of two rounds with MARK and RELEASE, and print the address of the first record:
10 PROGRAM TWICE;
20 TYPE NODE=RECORD V:INTEGER; NEXT:^NODE END;
30 LINK=^NODE;
40 VAR TOP,P,HEAP:LINK; N,R:INTEGER;
50 BEGIN
60 FOR R:=1 TO 2 DO
70 BEGIN
80 MARK(HEAP);
90 TOP:=NIL;
100 REPEAT
110 READ(N);
120 IF N<>0 THEN
130 BEGIN
140 NEW(P); P^.V:=N; P^.NEXT:=TOP; TOP:=P
150 END
160 UNTIL N=0;
170 P:=TOP;
180 WHILE P<>NIL DO
190 BEGIN WRITE(P^.V); P:=P^.NEXT END;
200 WRITELN('FIRST AT ',ADDR(TOP^));
210 RELEASE(HEAP)
220 END
230 END.
1 2 3 0
3 2 1 FIRST AT 3956
7 8 9 0
9 8 7 FIRST AT 3956
14.1 Column 17, row 11, counting from 0 - then the cursor well down, out of the way:
10 PROGRAM MIDDLE;
20 BEGIN
30 PAGE;
40 WRITE(CHR(29),CHR(17),CHR(11),'ADA');
50 WRITE(CHR(29),CHR(0),CHR(22))
60 END.
14.2
10 PROGRAM COUNTDOWN;
20 VAR I,J:INTEGER;
30 PROCEDURE GOTOXY(X,Y:INTEGER);
40 BEGIN
50 WRITE(CHR(29),CHR(X-1),CHR(Y-1))
60 END;
70 BEGIN
80 PAGE;
90 FOR I:=5 DOWNTO 1 DO
100 BEGIN
110 GOTOXY(20,12); WRITE(I);
120 FOR J:=1 TO 1500 DO
130 END;
140 GOTOXY(20,12); WRITE('GO');
150 GOTOXY(1,20)
160 END.
1,500 passes of an empty loop is about a second.
15.1 Column 35 of row 0 is near the top right:
10 (*$C-*)
20 PROGRAM KEYS;
30 VAR C:CHAR; N:INTEGER;
40 BEGIN
50 PAGE;
60 N:=0;
70 REPEAT
80 REPEAT C:=INCH UNTIL C<>CHR(0);
90 N:=N+1;
100 WRITE(CHR(29),CHR(35),CHR(0),N:4)
110 UNTIL C='Q';
120 WRITE(CHR(29),CHR(0),CHR(20))
130 END.
A, B, RIGHT and Q leave 4 in the corner.
15.2 Keep the direction in D; look at the keyboard every pass, but move only every 40th:
10 (*$C-*)
20 PROGRAM DRIFT;
30 VAR C,D:CHAR; X,Y,T:INTEGER;
40 PROCEDURE GOTOXY(X,Y:INTEGER);
50 BEGIN
60 WRITE(CHR(29),CHR(X-1),CHR(Y-1))
70 END;
80 BEGIN
90 PAGE;
100 X:=20; Y:=12; D:=']'; T:=0;
110 REPEAT
120 C:=INCH;
130 IF (C='[') OR (C=']') OR (C='^') OR (C=CHR(10))
140 THEN D:=C;
150 T:=T+1;
160 IF T=40 THEN
170 BEGIN
180 T:=0;
190 GOTOXY(X,Y); WRITE(' ');
200 IF (D='[') AND (X>1) THEN X:=X-1;
210 IF (D=']') AND (X<40) THEN X:=X+1;
220 IF (D='^') AND (Y>1) THEN Y:=Y-1;
230 IF (D=CHR(10)) AND (Y<23) THEN Y:=Y+1;
240 GOTOXY(X,Y); WRITE('*')
250 END
260 UNTIL C='Q';
270 GOTOXY(1,23)
280 END.
The * sets off to the right and stops at the edge; DOWN turns it. Hold Q a moment to stop - INCH has to catch it between moves.
16.1
10 PROGRAM COUNTS;
20 VAR N:ARRAY[1..6] OF INTEGER; I,D:INTEGER;
30 BEGIN
40 FOR D:=1 TO 6 DO N[D]:=0;
50 FOR I:=1 TO 600 DO
60 BEGIN
70 D:=RANDOM MOD 6+1;
80 N[D]:=N[D]+1
90 END;
100 FOR D:=1 TO 6 DO WRITE(N[D]);
110 WRITELN
120 END.
One run gave 106 99 82 73 130 110 - rather uneven for 600 throws, which is S16's point: a tight loop is where RANDOM is at its weakest.
16.2
10 (*$C-*)
20 PROGRAM GUESS;
30 VAR C:CHAR; N,G:INTEGER;
40 BEGIN
50 WRITELN('PRESS A KEY');
60 REPEAT C:=INCH UNTIL C<>CHR(0);
70 N:=RANDOM MOD 100+1;
80 REPEAT
90 WRITE('GUESS',CHR(63),' ');
100 READ(G);
110 IF G<N THEN WRITELN('HIGHER');
120 IF G>N THEN WRITELN('LOWER')
130 UNTIL G=N;
140 WRITELN('RIGHT')
150 END.
The number is picked the moment you press the key.
17.1
10 (*$C-*)
20 PROGRAM TARGET;
30 VAR C:CHAR;
40 BEGIN
50 PAGE;
60 POLY(FALSE,0,0,128,96,20,20,32,0);
70 POLY(FALSE,0,0,128,96,40,40,32,0);
80 POLY(FALSE,0,0,128,96,60,60,32,0);
90 REPEAT C:=INCH UNTIL C<>CHR(0);
100 PAGE
110 END.
17.2 A star of two short lines, drawn, left for a moment, and rubbed out with line type 1:
10 (*$C-*)
20 PROGRAM SHOOT;
30 VAR X,J:INTEGER;
40 PROCEDURE STAR(X,T:INTEGER);
50 BEGIN
60 DRAW(X-4,96,X+4,96,T);
70 DRAW(X,92,X,100,T)
80 END;
90 BEGIN
100 PAGE;
110 X:=10;
120 WHILE X<250 DO
130 BEGIN
140 STAR(X,0);
150 FOR J:=1 TO 2000 DO;
160 STAR(X,1);
170 X:=X+4
180 END
190 END.
18.1 Change line 150 of SCALE to 150 FOR I:=8 DOWNTO 1 DO.
18.2 The period moves by 4 each step, and turns round at 200 and 400:
10 (*$C-*)
20 PROGRAM SIREN;
30 VAR P,S,J:INTEGER; C:CHAR;
40 BEGIN
50 PSG(7,126);
60 PSG(8,12);
70 P:=400; S:=-4;
80 REPEAT
90 PSG(0,P MOD 256);
100 PSG(1,P DIV 256);
110 FOR J:=1 TO 100 DO;
120 P:=P+S;
130 IF (P<=200) OR (P>=400) THEN S:=-S;
140 C:=INCH
150 UNTIL C<>CHR(0);
160 PSG(8,0)
170 END.
19.1 Character 129's shape is eight bytes further on, at #1C08:
10 (*$C-*)
20 PROGRAM ARROWS;
30 VAR I:INTEGER;
40 S:ARRAY[1..8] OF INTEGER;
50 BEGIN
60 S[1]:=#10; S[2]:=#18; S[3]:=#FC; S[4]:=#FC;
70 S[5]:=#18; S[6]:=#10; S[7]:=#00; S[8]:=#00;
80 OUT(9,CHR(#08));
90 OUT(9,CHR(#1C+#40));
100 FOR I:=1 TO 8 DO OUT(8,CHR(S[I]));
110 FOR I:=1 TO 10 DO WRITE(CHR(129));
120 WRITELN
130 END.
19.2
10 PROGRAM REALBYTES;
20 VAR R:REAL; I:INTEGER;
30 BEGIN
40 R:=1.0;
50 FOR I:=0 TO 3 DO
60 WRITE(ORD(PEEK(ADDR(R)+I,CHAR)):2:H,CHR(32));
70 WRITELN
80 END.
prints 00 00 00 40: a real is four bytes, and for 1.0 all but the last are 0.
