home *** CD-ROM | disk | FTP | other *** search
/ CP/M / CPM_CDROM.iso / simtel / sigm / vols000 / vol019 / long.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1984-04-29  |  2.2 KB  |  84 lines
  1.  
  2. (************************************************************
  3. *
  4. *    Donated by Ray Penley, June 1980
  5. *
  6. ************************************************************)
  7.  
  8.  
  9.  
  10. (*$I+    [Show me the source code]  *)
  11. PROGRAM LONGLINE;
  12.  
  13. CONST
  14.   default  = 80 ; {Default length for strings}
  15.   LINESIZE = 80 ;
  16.  
  17. TYPE
  18.   alfa         = STRING 10 ;{just the right size}
  19.   shorty     = STRING 40 ;{ 1/2 of default length }
  20.   string40   = STRING 40 ;{ just say it another way }
  21.   string79   = STRING 79 ;{ ONE less than default length }
  22.   string80   = STRING 80 ;{ DEFAULT length }
  23.   Max_String = STRING 255;{ The BIG GUN }
  24. (*---Use these for the Pascal/Z supplied functins---*)
  25.   $STRING0   = STRING 0 ;
  26.   $STRING255 = STRING 255 ;
  27.  
  28. VAR
  29.   DONE : BOOLEAN ;
  30.   LINE : STRING LINESIZE ;
  31.   WORD : string80 ;
  32.  
  33. (*---Required for Pascal/Z supplied string functins---*)
  34. FUNCTION LENGTH(X: $STRING255): INTEGER; EXTERNAL;
  35. FUNCTION INDEX(X,Y :$STRING255): INTEGER; EXTERNAL;
  36. PROCEDURE SETLENGTH(VAR X :$STRING0; Y :INTEGER); EXTERNAL;
  37. (*----------------------------------------------------*)
  38.  
  39. PROCEDURE HEADING;
  40. BEGIN
  41.   WRITELN('TYPE ONE WORD AT A TIME AND THIS PROGRAM WILL');
  42.   WRITELN('ASSEMBLE THE WORDS INTO LINES OF ',LINESIZE:1, ' WORDS EACH');
  43.   WRITELN('TYPE ## TO STOP');
  44.   WRITELN;
  45. END;
  46.  
  47.  
  48. Procedure GetWord( var    xword       : string40 ;
  49.             req_length : integer  );
  50. var
  51.   temp : string 255;
  52. begin
  53.   SETLENGTH(xword,0);{start with a null string}
  54.   READLN(temp);
  55.   If length(temp)<=req_length then
  56.     APPEND(xword,temp)
  57. end;
  58.  
  59. BEGIN(* MAIN PROGRAM *)
  60.   HEADING;
  61.   SETLENGTH(WORD,0);
  62.   DONE := FALSE;
  63.   {---ATTEMPT TO READ THE FIRST WORD---}
  64.   WRITE('Enter the first word: ');
  65.   GetWord(WORD,20);
  66.   WHILE NOT DONE DO
  67.     BEGIN
  68.       SETLENGTH(LINE,0);
  69.       WHILE ( (LENGTH(LINE) + LENGTH(WORD)) < LINESIZE )
  70.        AND ( INDEX(WORD, '##')=0 ) DO
  71.         BEGIN(* Our Line will be composed of -
  72.          WORDS/SPACES/WORDS            *)
  73.       IF LENGTH(WORD) < LINESIZE THEN APPEND(WORD, ' ');
  74.       (*---LINE := LINE + WORD---*)
  75.       APPEND( LINE, WORD );
  76.       WRITE('Enter the next word: ');
  77.       GetWord(WORD,20);
  78.           IF WORD = '##' THEN DONE := TRUE;
  79.         END(*WHILE*);
  80.       WRITELN('Here is your Line:');
  81.       WRITELN(LINE)
  82.     END(* WHILE NOT DONE *)
  83. END.
  84.