GOSUB initialize

REPEAT
  poem$=STRING$(5,10)
  poemptrn$=ptrn$[RND(ptrns)]
  indent=28

  FOR i=1 TO LEN(poemptrn$)
    w$=poemptrn${i}
    REPEAT
      IF w$="J" THEN word$=adjv$[RND(adjvs)]
      IF w$="N" THEN word$=noun$[RND(nouns)]
      IF w$="V" THEN word$=verb$[RND(verbs)]
      IF w$="P" THEN word$=prep$[RND(preps)]
    UNTIL INSTR(poem$,word$)=0

    IF w$="A" THEN IF RND(2) >1 THEN word$="a" ELSE word$="the"
    word$=" "+word$
    IF INSTR(".;,-",w$) THEN word$=w$
    IF w$="/" THEN word$=indent${TO indent}: indent=indent+2
    poem$=poem$+word$
    word$=""
  NEXT

  REPEAT
    a=INSTR(a+1,poem$," a ")
    IF INSTR("aeiou",poem${a+3}) THEN poem$=poem${TO a+1}+"n"+poem${a+2 TO}
  UNTIL a=0

  BOX 1500;1800, XVIRTUAL-2100, 2000 FILL WITH 8 COLOUR 1
  PRINT AT(1;1) COLOUR(0) FONT(3) POINTS(18) MODE(2) poem$

  i$=UPPER$(INPUT$(1))
  IF i$="S" THEN PRINT #5 poem$
  IF i$="Q" THEN CLOSE #5: END
UNTIL infinity

LABEL initialize
  window_=2
  GOSUB open_
  WINDOW OPEN
  PRINT AT(4;12) COLOUR(4) FONT(3) POINTS(36) "Haiku Composer"
  PRINT AT(28;19) COLOUR(1) FONT(2) POINTS(10) "Press any key to view the next haiku"
  PRINT AT(35) COLOUR(1) FONT(2) POINTS(10) "S to save haiku"
  PRINT AT(37) COLOUR(1) FONT(2) POINTS(10) "Q to quit"
  LINE 0;1800, XVIRTUAL;1800 WIDTH 7 COLOUR 2
  LINE 0;3500, XVIRTUAL;3500 WIDTH 7 COLOUR 2

  window_=1
  GOSUB open_
  BOX 0;0, XVIRTUAL, YVIRTUAL FILL WITH 8 COLOUR 1
  BOX 0;0, XVIRTUAL, YVIRTUAL-200 COLOUR 2
  BOX 50;50, XVIRTUAL-100, YVIRTUAL-300 COLOUR 2
  GRAPHICS COLOUR 6 LINE WIDTH 5
  LINE 680;3300, 500;3010 START 2 END 2
  LINE 580;3050, 580;2770 START 2 END 2
  LINE 730;3140, 860;3140 START 2 WIDTH 3
  LINE 700;3010, 860;3010 START 2 WIDTH 3
  LINE 680;2870, 860;2870 START 2 WIDTH 3
  LINE 860;3250, 860;2870, 820;2770 START 2 END 2
  LINE 1010;3250, 1010;2770 START 2 END 2
  LINE 1010;3140, 1140;3140 END 2 WIDTH 3
  LINE 1010;3010, 1140;3010 END 2 WIDTH 3
  LINE 1010;2870, 1140;2870 END 2 WIDTH 3
  LINE 650;2500, 500;2300 START 2 END 2
  LINE 650;2450, 1140;2450 WIDTH 3
  LINE 1140;2450, 1140;1990 START 2
  CIRCLE 1000;1990, 140 PART RAD(245), 0
  BOX 600;2000, 250, 250 WIDTH 3

  CLOSE WINDOW 3
  CLOSE WINDOW 4

  OPEN #5 APPEND "A:\BASIC2\HAIKU.TXT"
  'Change pathname here as required.

  RANDOMIZE
  indent$=CHR$(13)+STRING$(2,10)+STRING$(29," ")
  ptrns=10
  adjvs=82: nouns=80: verbs=21: preps=14
  DIM ptrn$[ptrns], adjv$[adjvs], noun$[nouns], verb$[verbs], prep$[preps]

  FOR i=1 TO ptrns
    READ ptrn$[i]
  NEXT
  DATA /NPAN;/AJNPAN/JN, /AJNV;/AJJN/PAJN, "/JN/JJ,/ANV", /AJJN;/PAJN/ANV
  DATA /JN/JNV-/JJN, /JJN/PJN-/JN, /JN/JNPAJN-/ANV, /AJN/AJN-/NV
  DATA /JN/NPN/PAJN, /AJN.../ANVPAN/JJN

  FOR i=1 TO adjvs
    READ adjv$[i]
  NEXT
  DATA autumn,hidden,bitter,misty,silent,empty,dry,dark,summer,icy,delicate
  DATA quiet,white,swirling,dusky,cool,spring,winter,withered,twilight,dawn
  DATA wispy,azure,blue,billowing,broken,hazy,cold,damp,falling,frosty,long
  DATA late,lingering,limpid,little,morning,muddy,old,red,rough,still,small
  DATA sparkling,throbbing,vermilion,wandering,wild,black,crimson,young
  DATA silver,golden,drowsy,pearl,emerald,pale,distant,calm,shiny,bright
  DATA dappled,sleeping,awakened,dull,spreading,coloured,midsummer,grey
  DATA night,nearby,lone,torn,faraway,ragged,shadowy,stormy,dusty,thin
  DATA vivid,shady,green

  FOR i=1 TO nouns
    READ noun$[i]
  NEXT
  DATA beach,bird,blossom,breeze,brook,butterfly,bush,comet,cloud,cliff
  DATA daffodil,daybreak,dawn,dragonfly,dewdrop,dew,dusk,dust,eagle,field
  DATA fir,frost,flower,firefly,flame,feather,forest,glade,glitter,grass
  DATA haze,hill,image,lake,lily,leaf,meadow,moon,mountain,mist,morning
  DATA night,ocean,pine,pond,rain,raindrop,reflection,rainbow,river,rose
  DATA shadow,stream,sea,snowflake,swan,sunshine,snowfield,storm,star
  DATA sunrise,silence,shape,shade,sound,snow,sky,sunset,surf,sun,tree
  DATA thunder,valley,violet,water,wave,wind,wildflower,waterfall,woodland

  FOR i=1 TO verbs
    READ verb$[i]
  NEXT
  DATA has stopped,is trickling,struggles,has fallen,has passed,sleeps
  DATA cascades,flutters,has risen,dances,is falling,murmurs,is floating
  DATA tumbles,creeps,stirs,drifts,swirls,sinks,stoops,shakes

  FOR i=1 TO preps
    READ prep$[i]
  NEXT
  DATA on,in,under,below,beneath,over,above,near,beside,close to,by,before
  DATA behind,beyond

  i$=INPUT$(1)
  WINDOW OPEN
RETURN

LABEL open_
  CLOSE #window_
  OPEN #window_ WINDOW window_
  STREAM #window_
  SCREEN GRAPHICS XUSABLE FIXED, YUSABLE FIXED
  WINDOW PLACE 0;1
  WINDOW TITLE ""
  WINDOW CURSOR OFF
RETURN