'------------------------------------------------------------------------------------------------------------------------------------- ' ' Small HAIKU program, based on the FORTH version from Kent Peterson. ' ' Translated to BaCon by PvE in February 2011 - GPL. ' MI version by PvE in May 2019 - MIT License ' '------------------------------------------------------------------------------------------------------------------------------------- INCLUDE mi CONST zen$ = "iVBORw0KGgoAAAANSUhEUgAAACgAAAAoCAYAAACM/rhtAAAFgElEQVR42t2YeaycUxjG37m3S+xi15B7aex7LZFQpBRR0da1RURQIpZEIuiiqmq5tUWILegftdZWpbXE1uIPYg9dqFuqqT1BQ1vdZjxPz" \ "vP2O/PNN3fmm5n6w0l+mXtnvnPOc973Pe95z1ew1rcCKLVysHpam55dl+pLir30KdYYt9YYdQusJT6eYD/wZQ6RrqNU7YfeWj/wPFgF5oHJYKV+OxhsC17TOBRDC18HusAl4P0qk7vwLv3+XKMW7A8Wgx" \ "3AfeAasEL9dgYvgjf0PVu7RD4CRoFxoDtDZEGLXwB2AY+D0eDHRixIy3WC7cHvUR9OuJ0GpdCzwZrIkh+DQWA8uDkS6da7AEwBy8GH4E7wsqXCoh4Lzge7gr3AV9Fvbq1zwGOa7EItajU4EbykyXYHS6L" \ "5+msB+4DL5Z2GXexu4CTfpNzlsfc52NdCXH4q8WwLtbjjwFugr6x8LpgKbpNr++n7io3SiMB2DVSMrHilXDRcVnMrXg3OA0eCPyxJK0vBR3q+D1jbjAXnS+AeEhg3jxda7yG5+9uUlV2sL+YqC/F3qIXs" \ "4IttOM3QTR0SyL/PACMsbAqLJq42fin63MhCvFLk4iqLrRjAOzNWnkythJ32lFBukH8sbJYtLOy4M8ED4D3wsOVvg8Fl4ArwSy0LUkRnxjMrJHoTrZCJe38L6eV4cA8YYiGmVll5GqJ1+8jCa6Pv++r/3" \ "Sykr98sxOorlsqZeY+6E8CrYBE4CPwN5ljYBCP1vZ/bFMBN0C23dkfC2vV5LLjLQgo6H7xbS2CWYA8DDv6FVj0UvKnfZ4OjwUDwXaovY5XHGBP19Rljn2QhVJ6yENMVcViPBdOphMfYRdH3cyTwAAspqU" \ "39OBE3FI+x28G1UR//5AKetnASdclyZbu5lsA2ddjRwg7+GRxo4XjyMskFDgA/VbEQrTcpY3wmcJ7l0yUwtwV9pc+A08FhFjZDHCcukAn6r2hMTtRpIT55nn+m8YqWnNc7gWPUd3hegS7uVAs7ly5mQPt" \ "x5SJd4BgLOzt28eHgUjBLi0y7mEcjU8wMC5ssl0A+zGqFZyvrvg5LyqFYhAukNX5IjXEymAkmghsy5uBme70RF/v5OFOTrJQFmK+mgU+iZ2fLTcyNvkn8esBE7ptkXDSuf47UuC/IU3UJdPNzQKYH1oCb" \ "g0M04AQLO4+u+RW8A46ypJiI22ngWXCLhV2cbqdY2MF1W9DF+e4bJSG0DvMcCwFWz7dq5bQQk+tgiVxo5YmaC3oQ3AtutCRR04KM42EW6sjpWkzF9aCQIY5F5FxLUsP3Fsp7FguLtMIPLFQj7PO2XMwkv" \ "tqS+ORY21g445mellhSqnmK2lILZ5gMtYwbXiH6LOlh3sjuBmPBxhLLcosnSI+eHyCXMz2wEB2i/+dJhFuQqelRCwl+vCXnsh91PDpnaK7JlmSIMoEujlueO4qp5CZZgh285M+qqL2a5lWzQ1by74sKgW" \ "mafKxVlmZbWziB6AVWSQtSBltvwc0sHOg8xmZFE3iZVa3kZxshy861yuabYJJln8Xepmoxo+W9ChfHK4t3UlbJz7aVVsy2TK7bNIqvNrmQcTURPAHul0fieUoSNSzSxJBhZbM0FmhRpzhIqwk8QmGwTlY" \ "2q3wtwv95n95bru+xZJPEz7G/H5Fr5HZanLVhW7O3ulqN7mcSZoqZUGefstaIwNja1ZqHDOOK1wheL7lJer3BRW192bWhLOgCz7JQjDKxj8khsCkL/i8FVsuDTQv0N1CdFo66nloDqsWJmtXMHRtKYPzy" \ "iPfjr3Na0F8ssdxikdFSF3vC5U3tTwsVy7KcFmQtyReZF1tIvLnfX9dzqxskyy3PM3CrWiveUdc7R0Nv/v8LgU21fwGgmpo7zOrHzwAAAABJRU5ErkJggg==" CONST exit$ = "iVBORw0KGgoAAAANSUhEUgAAABgAAAAYCAMAAADXqc3KAAABWVBMVEUAAACGAwOCAACCAACDAACCAACCAADdkJCDAQGLBQWGAgKIBgaDAAAuNDb+/v53fHCipZ1dhTWxtK2Slo2Dh3zAwr00ZwPQ0c3e" \ "WlqCAADl5uM+bxDMAADpm5v8/fvC0bKdtoZ2mVXcTU3PRUVkiz82PTxRfSfo7eLV38uvw5yWmZSKp21vc2pjZl9VW1Y7QT/VKiqMDg7Cw8CvsK6Sk5Doh4eJjIWFiIR7fnd5fHVwc25mamZlaV9bXlVF" \ "TEpAR0XYOjo/LC7UJyeOFhaJEhKDCAjt8ejd5dXW19TXxsPO2sK+wLzFs7DvsLDNr623p6KlqKGwxJ2en5zrnJy8nJmampmhoJiqm5WvjYmJiofZhISBg3+jf3qSrXjVd3fjdnZvcmnRZ2eDomVpa2Xg" \ "Y2PfXV1eY1zcVFRmf1FKT1HcT0/bTExOaDg5Rji4Ly9GYy5HZSzSICDQFhaY5NBZAAAADXRSTlMA+BAj8DMJ/v358uvmi4gxEQAAAR5JREFUKM+F0lV3gzAYgGEo7TyDMu0MGDC8UJdVtsrc3d19+/8X" \ "SyislF30vcxzcpIvJ1i7gK8m7CePT3P5W8MA/TAPJHaSmaxuFIte6CAwEE9Qajp7VSh4IdBHgKU4vaWmc7reApHe+bGRIZoaGCTJFsA768t+COKo9ZPqmg8ik6jd1EV1k6ZmxSgJpmAIUi/TsNfL69oh" \ "JQKRBJIkLSC4q1iWVfn+efyoHdg7ZFleRDA6YTfHx84aZzAMs2KDHVw/cg5XFIVBgMO67/nYnnsrlmW3IQRgBM7XN/7m0DSNdQfs6vFMznHcuQvBEHDgwXwXBOHGfd0Q1oC8ab7NwDgEdghWM+Xy57id" \ "4AW1VPoadgp74Dn6FG4G2n6G//0CO2M0gIxlPskAAAAASUVORK5CYII=" CONST refresh$ = "iVBORw0KGgoAAAANSUhEUgAAABgAAAAYCAMAAADXqc3KAAAByFBMVEUAAAAAAAAAAAAAAAAHDh0AAAAoU44AAAAAAAAAAAAAAAAAAAArVY8cQ3YAAAAAAQEAAAAhS4cmUIsAAAAAAAApUowoU40mT4oh" \ "S4ciS4giTIkgR4AiTIkcRXwAAAAAAAAAAAAAAAAYP29mirgkTolSdqhAZZo3YJo6YZgwWZQiTYkdQXUgR38hSocfSoYgSYYdQ3kUMFoIFCIYN2MfR4MeR3wAAAAUM12Ansd1mMNfhbdQdqsuXp92lbxQ" \ "eK5JbqFlhrQ0YJ4sVpMiSoQhSYMjTYoeRHsiTIoZOmkXN2MhS4cXMlwULVIaOmgWNV4RJ0geRHkVMFYMHjchSoUNITseRYMcP3IJEyMRJ0ceR4IVLVQaPnIDBwoAAAAdQ34NHTYAAAAJFyoSJD8gS4Ag" \ "QIAgSod6pNG0y+WPr9Z4odByns9Zi8VJfb+3zealv9+UtdqGq9V+pdJ5n8xsmMxpmMxmlstgj8hcjcZRhMKyyOKsw+Cjvt+HqM9um81sm82Fo8thkshikMhNgcFSg79Jebm4z+esxuKdut2Msdicttd/" \ "qNSDp9SKrNOPrNB/pc9xm86Bo8tYicRmjsFEer1Qfbc/dLZEdLM7bq8i55c0AAAAZXRSTlMAAwUNCAr0BiobFhH5LS0mFPn4PzT69/X17d3cxVZEPDIfHvz79/f39/fjx6Cck4l6dmg6NSsYDP7+/v79" \ "/Pz5+PXy8eDY1c+4r6qfmZaMi4eFfn11b21saGRVT0o+PT03NhwYEJfwCX0AAAGgSURBVCjPnZDVViNBEIbT3ZOMbmbiLgR324V1d8fd6bg77u7+usD0cDjc8l9V1VeuerSe1n+z6mqcA+3gQXi6vvr5" \ "zkwgflBua4XA9eWO0jWlM3srxdXCUWLJ4nJpsFohDe9j8a34XDCVjyTnzeZ5zNGkf8XsUnmVSXhXmggVUvvJBC4hJY2vBMfvzpa+f7VCOrS8GN7GDLoFwImb3QajltGOd5gOM7lsEmsJsP1nRJZHaiSJ" \ "n18uZBd370DjpIQoCACg6ypD/hthhsyAFAVlo12HZdlEGUxZiWuHEJV4DW63QUvWfabZiAUCsxVNCFKIY1m2tUkNCIhlcqk3tcY2CkBI09RPJ+n8RBPI5sJBfT97kwgA6MINlAI2Q+Fl/wtT3ZDPN9pj" \ "11T3IkjAXDDoLyyk31bp9R8/XK5bxiQFHJcJ6fBJJL+SjxSjUfNfhiegzNL9S3+aiRRXo9GzC+GrQfmhzz5o9DbrKs/X1tavXut+DCsFKqCWOImb+OP4hK2O7y0ekZfPU15CI5YxekY8XpGVV7oXoBDP" \ "tXE8IjeorgGfpFnBrf9V4AAAAABJRU5ErkJggg==" CONST about$ = "iVBORw0KGgoAAAANSUhEUgAAABgAAAAYCAMAAADXqc3KAAABXFBMVEUAAAAAAAALBQAAAAAAAADGogEAAADLqgoPDQAAAADWuzXHowPGowHImwDEoQDizVnawDzKqhTIpgvFogDBnwHIpATHowHGpAPC" \ "oALFogDFoQCsigAqJABcRwDFogDy5p3s23br23br2Wzr2nHk0GngzF7LqhbexUTRtC3FpATIpgPgylzFnwDFogDDoQDHpATJpgW/ngG4mAC3lgDFoALEoQClhgCqiwDEnwCkhQBhUQBgTACdggDEogDG" \ "nwDBnwDEnQC/pgBdRgC2kgD551jEoQL+/Oz78Jb76mH45k3+/e79+tz9+NH89cH58rf662/762X66Vv9+uf+++L79sz78rP99K7786z576Dz5pb57pDw44/67ob87W7762r46WT56Fb45lH35Ef35EP2" \ "4z7Ipg/9+ur8+Nb787b27bP476r06an47qj37Jv57Yvx44P36nr66V7340j14TfDKGpbAAAARHRSTlMABAcLCfYV9R8N9fPeD/z5+Pf26tnX07ala1pVFRIL/v7+/v34+Pj29vb29fXm0cfFsJ6Ze2dS" \ "S0VDQkA5NC0lGhQLB9eLsDsAAAEUSURBVCjPtY1VT8NgGEbbfR2lMncmuLu7171zHzPc+f8Jo2FrSZpwtXN5Tt73gYaCiyQvbUNs3rNjG9bTtyHbT/40M3dhE8aW5fuZXZsQeWKrDxtWkwrTNO12djMq" \ "l+k6fwi4jHC6xDCMIAj5OseKongnZdEDyCC6kM1TularcRTf7rwqeGSw6x+XVE7TPm54KldBY+bMeWhWqut6z8se8gyycL1SqjabfEutuFNWDzsImWo1Gp3PHHEFWzSyjxfa7ONz+YvF44gD7nuARSfL" \ "hQmani6+T21i4LfACEgQiuINHh0HvcWXxQRA4P7FCVrybY322Pa9oYfA/JVcC8RHDPZWw0nHn3kEAAwDABlMm9EA+pdvJt0uOqQSAfQAAAAASUVORK5CYII=" CONST info$ = "The haiku generated is in\n" \ "the style of Matsuo Basho\n" \ "(松尾芭蕉), a Japanese poet of\n" \ "the 17th century.\n" \ "Ported to Bacon by Peter\n" \ "van Eerten. Original HUG\n" \ "version by vovchik." CONST HNL$ = "
" ' Define runtime check for size of array DEF FN bound(x) = SIZEOF(x)/SIZEOF(STRING) DECLARE adj$[] = { "autumn", "hidden", "bitter", "misty", "silent", "empty", "dry", "dark", "summer", "icy", \ "delicate", "quiet", "white", "cool", "spring", "winter", "patient", "twilight", "dawn", "crimson", \ "wispy", "weathered", "blue", "billowing", "broken", "cold", "damp", "falling", "frosty", "green", \ "long", "late", "lingering", "bold", "little", "morning", "muddy", "old", "red", "rough", \ "still", "small", "sparkling", "throbbing", "shy", "wandering", "withered", "wild", "black", "young", \ "holy", "solitary", "fragrant", "aged", "snowy", "proud", "floral", "restless", "divine", "polished", \ "ancient", "purple", "lively", "nameless" } DECLARE noun$[] = { "waterfall", "river", "breeze", "moon", "rain", "wind", "sea", "morning", "snow", "lake", \ "sunset", "pine", "shadow", "leaf", "dawn", "glitter", "forest", "hill", "cloud", "meadow", \ "sun", "glade", "bird", "brook", "butterfly", "bush", "dew", "dust", "field", "fire", \ "flower", "firefly", "feather", "grass", "haze", "mountain", "night", "pond", "darkness", "snowflake", \ "silence", "sound", "sky", "shape", "surf", "thunder", "violet", "water", "wildflower", "wave", \ "water", "resonance", "sun", "wood", "dream", "cherry", "tree", "fog", "frost", "voice", \ "paper", "frog", "smoke", "star" } DECLARE verb$[] = { "shakes", "drifts", "has stopped", "struggles", "hears", "has passed", "sleeps", "creeps", "flutters", "fades", \ "is falling", "trickles", "murmurs", "warms", "hides", "jumps", "is dreaming", "sleeps", "falls", "wanders", \ "waits", "has risen", "stands", "dying", "is drawing", "singing", "rises", "paints", "capturing", "flying", \ "lies", "picked up", "gathers in", "invites", "separates", "eats", "plants", "digs into", "has fallen", "weeping", \ "facing", "mourns", "tastes", "breaking", "shaking", "walks", "builds", "reveals", "piercing", "craves", \ "departing", "opens", "falling", "confronts", "keeps", "breaking", "is floating", "settles", "reaches", "illuminates", \ "closes", "leaves", "explodes", "drawing" } DECLARE prep$[] = { "on", "beside", "in", "beneath", "of", "above", "under", "by", "over", "against", "near" } FUNCTION Create_Haiku$ LOCAL haiku$ LOCAL which which = RANDOM(4) SELECT which CASE 0 haiku$ = adj$[RANDOM(bound(adj$))] & " " & noun$[RANDOM(bound(noun$))] & HNL$ haiku$ = haiku$ & noun$[RANDOM(bound(noun$))] & " " & verb$[RANDOM(bound(verb$))] & " " & prep$[RANDOM(bound(prep$))] & " " & noun$[RANDOM(bound(noun$))] & HNL$ haiku$ = haiku$ & adj$[RANDOM(bound(adj$))] & " " & adj$[RANDOM(bound(adj$))] & " " & noun$[RANDOM(bound(noun$))] CASE 1 haiku$ = adj$[RANDOM(bound(adj$))] & " " & noun$[RANDOM(bound(noun$))] & " " & verb$[RANDOM(bound(verb$))] & HNL$ haiku$ = haiku$ & adj$[RANDOM(bound(adj$))] & " " & adj$[RANDOM(bound(adj$))] & " " & noun$[RANDOM(bound(noun$))] & HNL$ haiku$ = haiku$ & verb$[RANDOM(bound(verb$))] & " " & adj$[RANDOM(bound(adj$))] & " " & noun$[RANDOM(bound(noun$))] CASE 2 haiku$ = adj$[RANDOM(bound(adj$))] & " " & adj$[RANDOM(bound(adj$))] & " " & noun$[RANDOM(bound(noun$))] & HNL$ haiku$ = haiku$ & prep$[RANDOM(bound(prep$))] & " " & adj$[RANDOM(bound(adj$))] & " " & noun$[RANDOM(bound(noun$))] & HNL$ haiku$ = haiku$ & noun$[RANDOM(bound(noun$))] & " " & verb$[RANDOM(bound(verb$))] CASE 3 haiku$ = noun$[RANDOM(bound(noun$))] & " " & prep$[RANDOM(bound(prep$))] & " " & noun$[RANDOM(bound(noun$))] & HNL$ haiku$ = haiku$ & adj$[RANDOM(bound(adj$))] & " " & noun$[RANDOM(bound(noun$))] & " " & prep$[RANDOM(bound(prep$))] & " " & noun$[RANDOM(bound(noun$))] & HNL$ haiku$ = haiku$ & adj$[RANDOM(bound(adj$))] & " " & noun$[RANDOM(bound(noun$))] END SELECT RETURN "
" & haiku$ & "
" ENDFUNCTION SUB New_Haiku TEXT("haiku", Create_Haiku$()) ENDSUB FRAME("frame", NULL, 5, 10, 240, 165) MARK("remark", "With apologies to 松尾芭蕉", 40, 20, 200, 40) MARK("zen", "", 120, 40, 40, 40) MARK("haiku", Create_Haiku$(), 10, 90, 255, 60) SEPARATOR("sep", 15, 140, 245, 1) MSGDIALOG("dlg", " Info", 15, 150, 70, 30, 0, info$) STOCK("more", " Next", 100, 150, 75, 30, New_Haiku) PROPERTY("more", "title", "Generate a new haiku.") STOCK("quit", " Exit", 190, 150, 70, 30, QUIT) PROPERTY("quit", "title", "Close Haiku and exit.") png$ = B64DEC$(zen$) BSAVE png$ TO "/tmp/haiku.png" SIZE LEN(png$) PROPERTY(NULL, "icon", "/tmp/haiku.png") DISPLAY("Haiku Generator", 275, 200)