program demoProgram(input, output); { Comments either in this sort of brace } (* or in this sort; both can span multiple lines. *) const {It's good practice to declare all numeric constants other than 0 and 1.} maxArray = 3; strLength = 30; type myArray = array [0 .. maxArray-1] of integer; strRange = 1 .. strLength; myString = packed array [strRange] of char; var array1, array2 : myArray; procedure writeString(message: myString); var index : integer; begin for index := 1 to strLength do write(output, message[index]); writeln(output); end; { writeString } procedure readData(message : myString; var here : myArray); var index : integer; begin writeString(message); for index := 0 to maxArray-1 do begin read(input, here[index]); end; { each index } end { readData}; procedure writeData(theData : myArray); type arrayIndex = 0 .. maxArray-1; var index : arrayIndex; begin for index := 0 to maxArray-1 do begin write(output, theData[index]:0, ' ') end; writeln(output); { just a new line } { write(chr(10)); } { just a cryptic new line } end { writeData }; procedure binSort; type setRange = 1 .. 1000; var smallSet : set of setRange; arrayIndex : integer; setIndex : setRange; begin smallSet := [ ]; { empty set } for arrayIndex := 0 to maxArray-1 do if array1[arrayIndex] in [1 .. 1000] then { if (array1[arrayIndex] >= 1) and (array1[arrayIndex] <= 1000) then } begin { writeln('debug: adding ', array1[arrayIndex]); } smallSet := smallSet + [array1[arrayIndex]]; { if not(array1[arrayIndex] in smallSet) then writeln(' error: ', array1[arrayIndex]:0, ' didn''t go in'); } end; writeln(output, 'Sorted values, omitting duplicates and those out of range:'); for setIndex := 1 to 1000 do if setIndex in smallSet then write(output, setIndex:0, ' '); writeln(output); end; { binSort } function sumUp(var thisArray : myArray) : real; var index : integer; answer : real; begin answer := 0.0; for index := 0 to maxArray-1 do answer := answer + thisArray[index]; sumUp := answer; end; { sumUp } procedure useRecords(var thisArray : myArray); type myStruct = record value : integer; next : ^myStruct; case large : boolean of true: ( piece1, piece2 : integer; ); false: ( expanded: real; ) end; var header, tmpNode, walker : ^myStruct; index : integer; begin { push elements onto list whose handle is 'header'} header := nil; for index := 0 to maxArray-1 do begin new(tmpNode); with tmpNode^ do begin value := thisArray[index]; next := header; large := value > 50; case large of false: expanded := sqrt(value); true: begin piece1 := value div 50; piece2 := value mod 50; end; end; end; {with tmpNode^} header := tmpNode; end; { each element of array } {print the list} writeln(output, 'List contains:'); walker := header; while (walker <> nil) do begin write(output, walker^.value:1, ' '); if walker^.large then write(output, '(', walker^.piece1:1, ',', walker^.piece2:1, ') ') else write(output, '(', walker^.expanded:1:1, ') '); walker := walker^.next; end; { each element of list } writeln(output); end; { useRecords } begin { main } writeln('Arrays hold ', maxArray:5, ' integers.'); readData('Give me some data: ...', array1); writeData(array1); binSort; writeln('Sum of all the data is ', sumUp(array1):5:1, ' averaging ', (sumUp(array1)/maxArray):5:5); useRecords(array1); end . { main } { other issues: modularity: should array1, array2 be global? should 1000 be a manifest constant? multi-dim arrays nested procedures dynamic-sized types exercise: bignums } { vim:nospell tw=70: }