Category : Modula II Source Code
Archive   : FM2DOC31.ZIP
Filename : USELISTS.MOD

 
Output of file : USELISTS.MOD contained in archive : FM2DOC31.ZIP
MODULE UseLists;

(* (C) Copyright 1992 Fitted Software Tools. All rights reserved. *)

(*
This module, in conjuction with MyLists and Lists shows examples
of operations on objects.

The examples are probably not too inspired, but they attempt
to cover most possibilities.
*)

FROM Objects IMPORT ALLOCATEOBJECT, DEALLOCATEOBJECT, MEMBEROBJECT;
FROM InOut IMPORT WriteString, WriteLine, WriteCard, Write, WriteLn;
FROM MyLists IMPORT MyLinkedListItem, MyLinkedList;
IMPORT ASCII;


(* LOCAL *) CLASS List;

(*
This class is like MyLinkedList.

The only difference is that you get the messages during list
creation and destruction.
*)

INHERIT MyLinkedList;

INIT
WriteLine( "<<< Creating a List >>>" );

DESTROY
WriteLine( "<<< List is being detroyed! >>>" );

END List;



(* LOCAL *) CLASS ListItem;

(*
ListItem expands MyLinkedListItem by adding a new attribute (data1) and
overriding the method print (to print out the contents of data1).

INIT initializes data1 to 0 and DESTROY lets you know what is happening.
*)

INHERIT MyLinkedListItem;

data1 :INTEGER;

PROCEDURE print; (* override MyLinkedListItem.print *)
BEGIN
WriteCard( data1, 1 );
END print;

PROCEDURE destroyMsg( s :ARRAY OF CHAR ); (* static method *)
BEGIN
WriteString( s );
print;
END destroyMsg;

INIT
data1 := 0;

DESTROY
IF MEMBER( SELF, NewListItem ) THEN
(* destroying a NewListItem *)
destroyMsg( " - " );
ELSE
destroyMsg( " - destroying ListItem: " );
END;

END ListItem;



(* LOCAL *) CLASS NewListItem;

(*
ListItem expands ListItem by adding a new attribute (data2) and
overriding the method print (it now prints out the contents of
data1 + data2).

INIT initializes data2 to 0 and DESTROY lets you know what is happening.
*)

INHERIT ListItem;

data2 :INTEGER;

PROCEDURE print; (* override ListItem.print *)
BEGIN
WriteCard( data1, 1 );
Write( '+' );
WriteCard( data2, 1 );
END print;

(* We know how to append ourselves to a List! *)
PROCEDURE appendToList( list :List ); (* static method *)
BEGIN
list.append( SELF );
END appendToList;

(* cannot override static method! *)
(*
PROCEDURE destroyMsg;
BEGIN
END destroyMsg;
*)

INIT
(* data1 initialized in ListItem.INIT *)
data2 := 0;

DESTROY
destroyMsg( " / destroying NewListItem:" );

END NewListItem;



VAR
aList :List;
anItem :ListItem;
aNewItem :NewListItem;
aBasicItem :MyLinkedListItem;

BEGIN
Write( ASCII.FF );

NEW(aList);

WriteLine( "Adding items (0,1,2,3,4) to aList" );
NEW(anItem); aList.append(anItem);
NEW(anItem); anItem.data1 := 1; aList.append(anItem);
NEW(anItem); anItem.data1 := 2; aList.append(anItem);
NEW(anItem); anItem.data1 := 3; aList.append(anItem);
NEW(anItem); anItem.data1 := 4; aList.append(anItem);

WriteLine( "Adding items (1+0,1+1,1+2,1+3,1+4) to aList" );

NEW(aNewItem); aNewItem.data1 := 1;
aNewItem.appendToList(aList);

NEW(aNewItem); aNewItem.data1 := 1; aNewItem.data2 := 1;
aNewItem.appendToList(aList);

NEW(aNewItem); aNewItem.data1 := 1; aNewItem.data2 := 2;
aNewItem.appendToList(aList);

NEW(aNewItem); aNewItem.data1 := 1; aNewItem.data2 := 3;
aList.append(aNewItem);

NEW(aNewItem); aNewItem.data1 := 1; aNewItem.data2 := 4;
aList.append(aNewItem);


WriteLine( "Items in aList (we will remove 0, 2 and 4):" );
IF aList.getfirst(anItem) THEN
REPEAT
anItem.print;
IF anItem.data1 MOD 2 = 0 THEN
WriteString(' removing ');
aList.delete( anItem ); (* remove it from list *)
DISPOSE( anItem ); (* and dispose of it *)
END;
WriteLn;
UNTIL NOT aList.getnext(anItem);
END;

WriteString( "Items remaining in aList:" );
IF aList.getfirst(anItem) THEN
REPEAT
anItem.print;
Write( ' ' );
UNTIL NOT aList.getnext(anItem);
END;
WriteLn;

WriteString( "ListItem objects: " );
IF aList.getfirst(aBasicItem) THEN
REPEAT
IF MEMBER( aBasicItem, ListItem ) THEN
aBasicItem.print;
Write( ' ' );
END;
UNTIL NOT aList.getnext(aBasicItem);
END;
WriteLn;

WriteString( "NewListItem objects (1): " );
IF aList.getfirst(aBasicItem) THEN
REPEAT
IF MEMBER( aBasicItem, NewListItem ) THEN
aBasicItem.print;
Write( ' ' );
(* had we wanted to invoke NewListItem specific methods,
we coud assign the object to aNewItem:
*)
aNewItem := NewListItem(aBasicItem);
END;
UNTIL NOT aList.getnext(aBasicItem);
END;
WriteLn;

(* not necessarily what it pretends to be... *)
(*
List.getfirst and List.getnext take, as a VAR parameter
any descendant of LinkedListItem. You can get yourself
in trouble if you pass one of these an object handle of
a descendant of an item to be returned, as you do, in
effect, break the type compatibility rules -- a handle
should never refer to an item which is an ancestor of the
handle type.
*)
WriteString( "NewListItem objects (2): " );
IF aList.getfirst(aNewItem) THEN
REPEAT
IF MEMBER( aNewItem, NewListItem ) THEN
aNewItem.print;
Write( ' ' );
ELSE
(* we got something that we should not attempt
to deal with or we would be breaking the rules...
-- we got a ListItem
*)
END;
UNTIL NOT aList.getnext(aNewItem);
END;
WriteLn;

WriteString( "LinkedListItem objects: " );
IF aList.getfirst(aBasicItem) THEN
REPEAT
IF MEMBER( aBasicItem, MyLinkedListItem ) THEN
aBasicItem.print;
Write( ' ' );
END;
UNTIL NOT aList.getnext(aBasicItem);
END;
WriteLn;

(* now we dispose of it all *)
DISPOSE( aList );
END UseLists.

  3 Responses to “Category : Modula II Source Code
Archive   : FM2DOC31.ZIP
Filename : USELISTS.MOD

  1. Very nice! Thank you for this wonderful archive. I wonder why I found it only now. Long live the BBS file archives!

  2. This is so awesome! 😀 I’d be cool if you could download an entire archive of this at once, though.

  3. But one thing that puzzles me is the “mtswslnkmcjklsdlsbdmMICROSOFT” string. There is an article about it here. It is definitely worth a read: http://www.os2museum.com/wp/mtswslnk/