Word Cloud

Post Reply
User avatar
rbytes
Posts: 1938
Joined: Sun May 31, 2015 12:11 am
My devices: iPhone X
iPad 4
MacBook
Dell Inspiron laptop
CHUWI Plus 10 convertible Windows/Android tablet
Location: Calgary, Canada
Flag: Canada
Contact:

Word Cloud

Post by rbytes » Fri Apr 12, 2019 4:41 am

A word cloud can be used for several things.
1. As a motivational tool, to remind you of qualities you want to develop.
2. As nostalgia stimulus, to bring back memories of your happiest times.
3. As a creativity jogger, to help you approach problems in different ways.
4. As a brainstorm display, to collect and display a group's ideas.

Usually a word cloud is made up of single words, but short phrases can also be used.
The most important words will appear the largest, with secondary or supporting words
shown in smaller sizes.

This is only a start. Its main innovation is its algorithm to ensure that words don't overlap,
or start or end off-screen.

Note: The Load button is not yet active. The Save button will save your word cloud image.

Code: Select all

/*
Word Cloud 1
by rbytes, January 2019
*/

prog$="Word Cloud 1"
DRAW FONT NAME "Arial-BoldMT"
SET TOOLBAR OFF
RANDOMIZE
OPTION SPRITE POS CENTRAL
SET ORIENTATION LANDSCAPE
SET BUTTONS CUSTOM
SHADOW ON
SHADOW OFFSET 10,10
SHADOW BLUR 4
laun$=LAUNCHER$ ()
dev$=DEVICE_TYPE$()
GET SCREEN SIZE sw,sh
iostest=0
IF iostest THEN
  sw=568
  sh=320
  dev$=""
ENDIF
rw=sw/1024!rh=sh/768!rh2=rw*.75
Image1$="starweb1.jpg"
Image2$="pylon.jpg"
word$="nature skies rivers lakes forests mountains waterfalls sunsets grass trees fields paths brooks sunshine bushes parks biking lichens sunrises moss trails clearings nature skies rivers lakes forests mountains waterfalls sunsets grass trees tracks beaches waves rain shores lagoons paths clouds moon animals hiking relaxing walking resting underbrush"
S$="start"!T$="reset"
N$="help"! O$="load"
V$="save"! Q$="quit"
buff=5        ' buffer space around each word
DRAW COLOR 0,0,0
SET BUTTONS FONT SIZE 20*rw
BUTTON S$ TEXT "START" AT 60*rw,700*rh SIZE 80*rw,30*rw    ' start button
BUTTON T$ TEXT "RESET" AT 150*rw,700*rh SIZE 80*rw,30*rw   ' reset button
BUTTON O$ TEXT "LOAD" AT 795*rw,700*rh SIZE 80*rw,30*rw    ' load button
BUTTON V$ TEXT "SAVE" AT 885*rw,700*rh SIZE 80*rw,30*rw    ' save button
IF sw<1024 THEN corr=10 ELSE corr=0
GRAPHICS
GRAPHICS CLEAR .2,.2,.2
drawinfobar
split$=" "
SPLIT word$ TO M$,N WITH split$
DIM loc(N,4)
y=30
gosub draw

do slowdown
  ' reset
  IF bp(T$) THEN
    GRAPHICS CLEAR .2,.2,.2
  ENDIF

  ' start
  IF bp(S$) THEN
    'slowdown
    gosub draw:
  ENDIF

  ' go to debug screen
  IF bp("debug") THEN DEBUG PAUSE

  ' save image
  IF bp(V$) THEN
    graphics save 0,0,sw,sh to "wordcloud.jpg"
  endif
  
  ' update infobar with changes
  IF CURRENT_MINUTE()<>oldmin OR BATTERY_LEVEL()<>oldlev OR BATTERY_STATE()<>oldstat THEN
    oldmin=CURRENT_MINUTE()
    oldlev=BATTERY_LEVEL()
    oldstat=BATTERY_STATE()
    drawinfobar
  END IF

  IF bp(Q$) THEN
    ender:
    IF laun$="desktop" THEN
      IF FILE_EXISTS("/launch") THEN
        RUN "/-Launch.sb"
      ELSE
        EXIT
      ENDIF
    ENDIF
    END
  END IF
  SLOWDOWN
UNTIL 0
end

' flag if the new text will intrude in the space of any text already printed
overlap:
' check text areas already used and flag any intrusion so no text is drawn there.
' if any corner of the new text is in an occupied area, set flag to 1.
' if any corner is off-screen then set flag to 1.
for q=0 to t

' upper left
  if temp1>=loc(q,0)-buff and temp1<=loc(q,2)+buff and temp2>=loc(q,1)-buff and temp2<=loc(q,3)+buff then flag=1

' lower left
if temp1>=loc(q,0)-buff and temp1<=loc(q,2)+buff and temp4>=loc(q,1)-buff and temp4<=loc(q,3)+buff then flag=1

' upper right
if temp3>=loc(q,0)-buff and temp3<=loc(q,2)+buff and temp2>=loc(q,1)-buff and temp2<=loc(q,3)+buff then flag=1

' lower right
  if temp3>=loc(q,0)-buff and temp3<=loc(q,2)+buff and temp4>=loc(q,1)-buff and temp4<=loc(q,3)+buff then flag=1

' midpoint
if temp5>=loc(q,0)-buff and temp5<=loc(q,2)+buff and temp6>=loc(q,1)-buff and temp6<=loc(q,3)+buff then flag=1

' off-screen
  if temp1<0 or temp2<0 then flag=1
  if temp3>sw or temp4>sh then flag=1


next q
return


draw:
    For t=0 to n-1
      repeat:
      flag=0
      

      ' gradually reduce font size as the cloud is filled in

      if t<n*.2 then draw font size rnd(20)+80
      if t>=n*.2 and t<n*.4 then draw font size rnd(16)+50
      if t>=n*.4 and t<n*.6 then draw font size rnd(12)+40
      if t>=n*.6 and t<n*.8 then draw font size rnd(10)+30
      if t>n*.8 then draw font size rnd(8)+24
      
      draw color .3+rnd(.7), .3+rnd(.7), .3+rnd(.7)
      temp1=rnd(sw*.9)                 ' upper left x position of word cell
      temp2=rnd(sh*.9)                 ' upper left y position of word cell
      temp3=temp1+TEXT_WIDTH (M$(t))   ' lower right x position of word cell
      temp4=temp2+TEXT_HEIGHT (M$(t))  ' lower right y position of word cell
      temp5=(temp1+temp3)/2            ' x midpoint
      temp6=(temp2+temp4)/2            ' y midpoint
      gosub overlap
      if not flag then draw text m$(t) at temp1,temp2 else repeat
      loc(t,0)=temp1!loc(t,1)=temp2    ' store upper left corner
      loc(t,2)=temp3!loc(t,3)=temp4    ' store lower right corner
      pause .1
    next t
return

DEF bp(a$) = BUTTON_PRESSED(a$)

'b'
' file browser/selector            Thanks to Henko for the original code
' returns selected file with path

DEF file_select$(xtop,ytop,wid,hgt,type,path$)
OPTION BASE 1
PAGE "freq" SET
PAGE "freq" SHOW
PAGE "" HIDE
'type = 1 for load, 2 for save
maxdim=500 ! SET LISTS CUSTOM
trans=0
DIM directs$(maxdim),FILES$(maxdim), combi$(2*maxdim)
FILL COLOR 1,1,1 ! DRAW COLOR 0,0,0
sw=.sw ! sh=.sh
rw=.rw ! rh=.rh
wid=320*rw
headspace=50*rw
SET LISTS FONT SIZE 18*rw
IF type=1 THEN
  fb$="Select file"&CHR$(10)&CHR$(10)&"Click OK to load it"&CHR$(10)&CHR$(10)&"Or RENAME or DELETE it"&CHR$(10)&CHR$(10)&"Click CANCEL to escape"
ELSE
  fb$="Select or name file"&CHR$(10)&CHR$(10)&"Click OK to save it"&CHR$(10)&CHR$(10)&"Or RENAME or DELETE it"&CHR$(10)&CHR$(10)&"Click CANCEL to escape"
ENDIF
IF xtop+wid>sw-10 THEN xtop=sw-wid-10 ! xbot=xtop+wid
IF ytop+hgt>sh-10 THEN ytop=sh-hgt-10 ! ybot=ytop+hgt*1.6
SPRITE "fbrow" SCAN xtop-2,ytop-2,wid+4,hgt+4
DRAW SIZE 3 !FILL RECT xtop,ytop TO xbot,ybot*.8
DRAW RECT xtop,ytop TO xbot,ybot*.8
DRAW LINE xtop,ytop*6 TO xbot,ytop*6
DRAW FONT SIZE 22*.rw
DRAW COLOR 0,0,0
DRAW TEXT title$ AT sw*.18,ytop+sh*.116
DRAW TEXT title2$ AT sw*.18,ytop+sh*.166
DRAW TEXT title3$ AT sw*.18,ytop+sh*.216
FIELD "namer" TEXT "" AT xtop+wid*.05,ytop+hgt*1 SIZE wid*.87,hgt*.18
FIELD "namer" FONT SIZE 20*.rw
FIELD "namer" FONT NAME "Arial-BoldMT"
IF fil$="" THEN fil$=.backfil$
FIELD "namer" TEXT fil$
procnam$=fil$
FIELD "feedback" TEXT fb$ AT xtop*.4,ytop*1.6 SIZE sw*.16+2,sh*.413 RO ML
DRAW RECT xtop*.4-2,ytop*1.6-2 TO xtop*.4+sw*.16+3,ytop+hgt*.35+sh*.31
FIELD "feedback" FONT SIZE 20*.rw
FIELD "filter" TEXT "filter" AT xtop*2.005,ytop+hgt*.08 SIZE sw*.216,sh*.05
FIELD "filter" FONT SIZE 20*.rw
DRAW RECT 20*rw, sh/2 TO 463*rw,sh-51*rw
DRAW RECT sw/1.875, sh/2 TO sw-34*rw,sh-51*rw
BUTTON "cancel" title "MAIN" AT xtop*2,ytop+hgt*.8 SIZE sw*.1,sh*.07
BUTTON "ok" title "OK" AT xtop*2,ytop+hgt*1.05 SIZE sw*.1,sh*.07
BUTTON "back" title "BACK" AT xtop*2,ytop+hgt*.55 SIZE sw*.1,sh*.07
BUTTON "root" title "ROOT" AT xtop*2,ytop+hgt*.3 SIZE sw*.1,sh*.07
BUTTON "+dir" title "+ DIR" AT xtop*2.34,ytop+hgt*1.05 SIZE sw*.1,sh*.07
BUTTON "-dir" title "- DIR" AT xtop*2.34,ytop+hgt*.8 SIZE sw*.1,sh*.07
BUTTON "rename" title "RENAME" AT xtop*2.34,ytop+hgt*.3 SIZE sw*.1,sh*.07
BUTTON "del" title "DELETE" AT xtop*2.34,ytop+hgt*.55 SIZE sw*.1,sh*.07
FILL COLOR 1,.5,.5
SET BUTTONS FONT SIZE 18*rw
BUTTON "im1" title "Image 1" AT sw*.186,sh*.47 SIZE 90*rw,40*rh
FILL COLOR 1,1,1
im1=1
BUTTON "im2" title "Image 2" AT sw*.71,sh*.48 SIZE 90*rw,40*rh
DRAW ALPHA 1
FILL ALPHA 0
BUTTON "clrfld" TEXT CHR$(8855) AT xtop*1.77,ytop+hgt*1.02
DRAW ALPHA 1
FILL ALPHA 1
IF type=2 THEN
  filter$=""
ELSE
  filter$=""
ENDIF
filter2$=""
fil$=""
fil_lab1: DIR$=""
fil_lab2: 
IF DIR$>"" THEN path$=path$ & "/" & DIR$ & "/"
fil_lab21:
DIR path$ LIST DIRS directs$,n1
DIR path$ LIST FILES FILES$,n2
fil_lab3:
IF n1 THEN
  FOR i=1 TO n1 ! combi$(i)="DIR: " & directs$(i) ! NEXT i
  END IF
fil_lab4:
ntot=n1
IF n2 THEN
  FOR i=1 TO n2
    IF filter$="" OR filter$="filter" OR INSTR(FILES$(i),filter$)>=0 OR (type=1 AND INSTR(FILES$(i),filter2$)>=0) THEN
      ntot+=1 ! combi$(ntot)=FILES$(i)
      END IF
    NEXT i
  END IF
IF ntot=0 THEN ! ntot=1 ! combi$(1)="" ! END IF
DIM temp$(ntot)
FOR i=1 TO ntot ! temp$(i)=combi$(i) ! NEXT i
LIST "fsel" TEXT temp$ AT xtop+2*rw,sh*.03 SIZE xbot-xtop-4*rw,hgt*.93
DRAW SIZE 3 ! DRAW LINE xtop,ytop+hgt*.95 TO xbot,ytop+hgt*.95
.path$=path$ ! .fil$=fil$

fil_lab5:
IF BUTTON_PRESSED("-dir") THEN
  dirop=1
  fb$="Select directory"&CHR$(10)&CHR$(10)&"Click OK to delete it"&CHR$(10)&CHR$(10)&"Click CANCEL to escape"
  FIELD "feedback" TEXT fb$
ENDIF
IF BUTTON_PRESSED("+dir") THEN
  dirop=2
  fb$="Enter name of new directory"&CHR$(10)&CHR$(10)&"Click OK to create it"&CHR$(10)&CHR$(10)&"Click CANCEL to escape"
  FIELD "feedback" TEXT fb$
ENDIF
IF BUTTON_PRESSED("cancel") THEN
  ret$="" ! GOTO fil_lab6
END IF
IF BUTTON_PRESSED("im1") THEN
   FILL COLOR 1,.5,.5
   BUTTON "im1" title "Image 1" AT sw*.186,sh*.47 SIZE 90*rw,40*rh
   FILL COLOR 1,1,1
   BUTTON "im2" title "Image 2" AT sw*.71,sh*.48 SIZE 90*rw,40*rh
   im1=1!im2=0
ENDIF
IF BUTTON_PRESSED("im2") THEN
   FILL COLOR 1,.5,.5
   BUTTON "im2" title "Image 2" AT sw*.71,sh*.48 SIZE 90*rw,40*rh
   FILL COLOR 1,1,1
   BUTTON "im1" title "Image 1" AT sw*.186,sh*.47 SIZE 90*rw,40*rh
   im1=0!im2=1
ENDIF
IF BUTTON_PRESSED("clrfld") THEN FIELD "namer" TEXT ""
IF BUTTON_PRESSED("del") THEN
  'if file not yet selected, ask user to select one.
  checksel=LIST_SELECTED("fsel")
  IF checksel=-1 THEN
    fb$="You must first select a file to delete."
    GOTO skipremove
  ENDIF
fil$=temp$(checksel)
fb$="Are you sure you wish to delete the file """&fil$&""" ? If yes, press OK. If no, press Cancel. A deleted file cannot be recovered!"
deleter=1
skipremove:
FIELD "feedback" TEXT fb$
BEEP
BEEP
ENDIF

IF BUTTON_PRESSED("rename") THEN
'if not yet selected, ask user to select a file.
  checksel=LIST_SELECTED("fsel")
  IF checksel=-1 THEN
    fb$="You must first select a file to rename."
    GOTO skiprename
  ENDIF
fil$=temp$(checksel)
fb$="Are you sure you wish to rename the file """&fil$&""" ? If yes, enter the new name and press OK. If no, press Cancel."
FIELD "feedback" TEXT fb$
renamer=1
skiprename:
FIELD "feedback" TEXT fb$
BEEP
ENDIF
IF BUTTON_PRESSED("ok") THEN
  IF RIGHT$(path$,1)<>"/" THEN path$&="/"
  IF FIELD_TEXT$("namer")<>"" THEN fil$=FIELD_TEXT$("namer")
  IF dirop=2 AND fil$<>"" THEN
    DIR path$&fil$ CREATE
    FIELD "namer" TEXT ""
    dirop=0
    GOTO fil_lab21
  ENDIF
  IF dirop=1 AND fil$<>"" THEN
    DIR path$&fil$ DELETE
    FIELD "namer" TEXT ""
    dirop=0
    GOTO fil_lab21
  ENDIF
  IF deleter THEN
    FILE path$&fil$ DELETE
    deleter=0
    ret$=""
    GOTO fil_lab21
  ENDIF
  IF renamer THEN
    FILE path$&combi$(sel) RENAME path$&fil$
    renamer=0
    ret$=""
    GOTO fil_lab21
  ENDIF
  IF fil$>"" THEN
    IF path$ > "" THEN
     ret$=path$ & fil$
    ELSE
     ret$ = fil$
    END IF
    GET IMAGE ret$ SIZE hor,ver
    IF im1 THEN
      im1name$=ret$
      ir1=MAX(1024/hor,768/ver)
      SPRITE "i1" LOAD ret$
      SPRITE "i1" AT sw*.236,sh*.717 SCALE MIN(440/hor,330/ver)
      SPRITE "i1" SHOW
     
    ELSE
      im2name$=ret$
      ir2=MAX(1024/hor,768/ver)
      SPRITE "i2" LOAD ret$
      SPRITE "i2" AT sw*.75,sh*.717 SCALE MIN(440/hor,330/ver)
      SPRITE "i2" SHOW
    ENDIF
    ' use formula to set sprite scale to fit preview window
    ' change formula to scale sprite to full screen in MAIN
    GOTO fil_lab21
  END IF
END IF

IF filter$<>filterhold$ THEN
  filter$=FIELD_TEXT$("filter")
  'filterhold$=FIELD_TEXT$ ("filter")
  GOTO fil_lab4
END IF
  filterhold$=FIELD_TEXT$ ("filter")
IF FIELD_CHANGED("namer") THEN
  fil$=FIELD_TEXT$("namer")
  LIST "fsel" SELECT -1
  GOTO fil_lab4
ENDIF
IF BUTTON_PRESSED("back") THEN 
  IF path$<>"Listful/" THEN
    IF RIGHT$(path$,1)="/" THEN path$=LEFT$(path$,LEN(path$)-1)
    FOR k=LEN(path$) TO 1 STEP -1
      IF MID$(path$,k,1)="/" THEN BREAK
      NEXT k
    IF k THEN ! path$=LEFT$(path$,k) ! GOTO fil_lab21 ! END IF
  ENDIF
END IF
IF BUTTON_PRESSED("root") THEN
  path$="/" ! DIR$=""
  GOTO fil_lab21
END IF
IF BUTTON_PRESSED("quit") THEN
  IF .laun$="desktop" THEN EXIT
  IF .laun$="basic" THEN END
ENDIF
IF BUTTON_PRESSED("debug") THEN DEBUG PAUSE
sel=LIST_SELECTED("fsel")
IF sel>0 THEN
  IF sel>n1 THEN
     IF NOT trans THEN FIELD "namer" TEXT combi$(sel)
     trans=1
     IF FIELD_CHANGED ("namer") THEN trans=0
     IF sel<>tempsel THEN trans=0
     IF FIELD_TEXT$("namer")="" THEN
        fil$=combi$(sel)
     ELSE
        'FIELD "namer" TEXT combi$(sel)
        fil$=FIELD_TEXT$("namer")
     ENDIF
     tempsel=sel
    GOTO fil_lab5
    ELSE
    IF dirop<>1 THEN
      DIR$=directs$(sel) ! GOTO fil_lab2
    ELSE
      FIELD "namer" TEXT MID$(combi$(sel),6,45)
    ENDIF
    END IF
  END IF
  SLOWDOWN
GOTO fil_lab5

fil_lab6:
BUTTON "cancel" DELETE ! BUTTON "ok" DELETE ! BUTTON "clrfld" DELETE
BUTTON "rename" DELETE ! BUTTON "del" DELETE ! BUTTON "root" DELETE
BUTTON "back" DELETE ! BUTTON "+dir" DELETE ! BUTTON "-dir" DELETE
FIELD "namer" DELETE ! LIST "fsel" DELETE
FIELD "filter" DELETE 
SPRITE "fbrow" AT xtop-2,ytop-2 ! SPRITE "fbrow" STAMP
SPRITE "fbrow" DELETE ! FIELD "feedback" DELETE
DRAW SIZE 1
GRAPHICS CLEAR .7, .7, .7
IF type =2 THEN
  DRAW FONT SIZE 40*.rw
  DRAW TEXT "SAVING" AT sw/2-TEXT_WIDTH("SAVING")/2+10, sh/2
ENDIF
.path$=path$
.act=1
PAGE "freq" HIDE
PAGE "" SET
PAGE "" SHOW
RETURN ret$
END DEF

'g'
' custom top toolbar

DEF drawinfobar()                        ' Thanks to Dav for the original code
if .act then corr=50
tb$="Battery"
FILL ALPHA 0
hs=file_select$.headspace
sw=.sw!sh=.sh
aj=sw/5
rw=.rw!rh=.rh
ypos=3
SET BUTTONS CUSTOM
SET BUTTONS FONT SIZE 18*rw
'=== show device info
sv$=DEVICE_TYPE$()&" with iOS "&SYSTEM_VERSION()
'===show time
ampm$="AM" ! hr=CURRENT_HOUR()
MIN$=STR$(CURRENT_MINUTE())
IF LEN(MIN$)=1 THEN MIN$="0"&MIN$
IF hr>11 THEN ampm$="PM"
IF hr>12 THEN hr=hr-12
IF hr=0 THEN hr=12
tm$=STR$(hr)&":"&MIN$&" "&ampm$
tx=((sw/2)-TEXT_WIDTH(tm$)/2)

'===show battery condition
bat$=STR$(BATTERY_LEVEL())&"%"
lev=BATTERY_LEVEL()
tat=BATTERY_STATE ()
IF tat THEN tat$="~" ELSE tat$=""

FILL COLOR 0,0,0
DRAW COLOR 0,0,0
BUTTON "sdebug" TEXT CHR$(8545) AT 5,ypos-7*rh
BUTTON "sdev" TEXT sv$ AT 29*rw+corr,ypos-7*rh
BUTTON "sapp" TEXT .prog$ AT -hs+ sw/2-TEXT_WIDTH(bat$)/2-30*rw+corr,ypos-7*rh
BUTTON "sbat" TEXT bat$ AT -hs+ sw-aj-TEXT_WIDTH(bat$)-83*rw+corr,ypos-7*rh
BUTTON "stat" TEXT tat$ AT -hs+ sw-aj-TEXT_WIDTH(bat$)+52*rw+corr,ypos-7*rh
BUTTON "stime" TEXT tm$ AT -hs+ tx-aj+corr,ypos-7*rh
BUTTON "squit" TEXT "X" AT sw-33,ypos-7*rh
DRAW COLOR 1,1,1
BUTTON "debug" TEXT CHR$(8545) AT 4,ypos-7*rh-1
BUTTON "dev" TEXT sv$ AT 28*rw+corr,ypos-7*rh-1
BUTTON "app" TEXT .prog$ AT -hs+ sw/2-TEXT_WIDTH(bat$)/2-31*rw+corr,ypos-7*rh-1
BUTTON "bat" TEXT bat$ AT -hs+ sw-aj-TEXT_WIDTH(bat$)-84*rw+corr,ypos-7*rh-1
BUTTON "tat" TEXT tat$ AT -hs+ sw-aj-TEXT_WIDTH(bat$)+51*rw+corr,ypos-7*rh-1
BUTTON "time" TEXT tm$ AT -hs+ tx-aj-1+corr,ypos-7*rh-1
BUTTON "quit" TEXT "X" AT sw-34,ypos-7*rh-1

'=== draw battery graphics
FILL ALPHA 1
DRAW ALPHA 1
DRAW SIZE 1
SHADOW OFFSET 0,0
SPRITE TB$ BEGIN sw/8,20*rh
FILL COLOR 0,0,0
DRAW COLOR 0,0,0
DRAW RECT 45*rw,ypos+2 TO 81*rw,ypos+14*rh
FILL RECT 45*rw,ypos+2 TO 42*rw+lev*levfactor,ypos+14*rh
FILL RECT 81*rw,ypos+7*rh TO 83*rw,ypos+11*rh
FILL COLOR 1,1,1
DRAW COLOR 1,1,1
levfactor=rw*.348

DRAW SIZE 1
DRAW RECT 44*rw,ypos TO 80*rw,ypos+12*rh
FILL RECT 44*rw,ypos TO 44*rw+lev*levfactor,ypos+12*rh
FILL RECT 80*rw,ypos+3*rh TO 82*rw,ypos+9*rh
SPRITE TB$ END
SPRITE TB$ AT 790*rw,14*rw
SPRITE TB$ SHOW
tat=BATTERY_STATE ()
IF tat THEN tat$="~" ELSE tat$=""         ' Show ~ if battery is charging
BUTTON "stat" TEXT tat$
DRAW COLOR 1,1,1
BUTTON "tat" TEXT tat$

'DRAW COLOR 0,0,0
'FILL COLOR 1,1,1
SET BUTTONS FONT SIZE 22*rw
'refresh off
RETURN
end def
''
Attachments
86F60443-4AA5-47CA-9D0A-B28800F97BD2.png
86F60443-4AA5-47CA-9D0A-B28800F97BD2.png (615.3 KiB) Viewed 170 times
####### Living the colorful life #######

matt7
Posts: 97
Joined: Sun Jul 12, 2015 5:00 pm
My devices: iPhone 8, Windows
Location: Kentucky, USA

Re: Word Cloud

Post by matt7 » Fri Apr 12, 2019 6:45 am

Looks great! I like the color palette. It would be cool to have an algorithm before doing the render that takes a text file input (or just a string) and scans it for the word list (ignoring short common words like articles and prepositions) and also keep track of word frequency. Then the rendering code could be adjusted to size the words proportional to their frequency.

The first part would be the most challenging though. I'm not sure how else to do it other than to manually specify a long list of words to exclude (like a, an, the, of, . . . ), and then you still have the problem of whether you try and deal with different forms of the same root (singular form vs. plural form of a noun, different tenses of a verb, etc.).

User avatar
rbytes
Posts: 1938
Joined: Sun May 31, 2015 12:11 am
My devices: iPhone X
iPad 4
MacBook
Dell Inspiron laptop
CHUWI Plus 10 convertible Windows/Android tablet
Location: Calgary, Canada
Flag: Canada
Contact:

Re: Word Cloud

Post by rbytes » Fri Apr 12, 2019 1:43 pm

Thanks. For this first version, I just put the most important (or at least more general) words closest to the start of the list. I have some newer versions I will post in the next few months, which do base the word size on frequency. The other idea, of inputting any text and excluding the articles, prepositions, etc. is a good one. I will see about implementing it.

There are a few word cloud apps available on the store. Some of them can shape the outside edge of the cloud, and I have duplicated that feature. Others can choose a rotational pattern for words, so I also added that to my latest edition.

I'm glad you like the color scheme. I find it effective for the "nostalgia" clouds, but prefer more saturated colors for the motivational or celebration themes. So I will eventually add some color theme options.
####### Living the colorful life #######

Henko
Posts: 849
Joined: Tue Apr 09, 2013 12:23 pm
My devices: iPhone,iPad
Windows
Location: Groningen, Netherlands
Flag: Netherlands

Re: Word Cloud

Post by Henko » Fri Apr 12, 2019 2:47 pm

Hi Richard,
What, if i have hundreds of ideas:
380F02D7-A1B4-47D7-A811-6BB05B947B5B.png
380F02D7-A1B4-47D7-A811-6BB05B947B5B.png (1.86 MiB) Viewed 154 times
😂

Some suggestion (you said it's only a start):
For use as a brainstorm tool:
- the sheet must be able to be build one word at the time
- an accompanying note should be attached (in the background) to each word
- each word should be selectable, be it directly on the screen, or via a list
- when selected, the accompanying note must pop up for reading/updating
- a report on the printer with all words and (indented) notes
- maybe some kind of hierarchy relations between the words (main items - sub items)

And in general about the presentation: if the words are drawn using a sprite, each word may be randomly rotated a few degrees, which produces a more lively overall picture.

User avatar
rbytes
Posts: 1938
Joined: Sun May 31, 2015 12:11 am
My devices: iPhone X
iPad 4
MacBook
Dell Inspiron laptop
CHUWI Plus 10 convertible Windows/Android tablet
Location: Calgary, Canada
Flag: Canada
Contact:

Re: Word Cloud

Post by rbytes » Fri Apr 12, 2019 3:28 pm

Great suggestions, Henk! I'll see what I can do. Feel free to post your own version(s), and lets see where we can take this.

I like your sample image. I should have mentioned that each run will produce non-overlapping words, but if you run multiple cycles without resetting, you can get this overprinted effect. It is chaotic and yet full of energy, so might be nice on something like a poster or greeting card.

Also you may occasionally find that the program "hangs". This is not a coding problem per se, but a "checkmate" of the non-overprint algorithm. The program is stymied because it cannot randomly find a free space large enough to print the next word. It may seem to us that there is space, but the program uses the text size command to find open spaces. In my later versions, I trap for this condition and exit the loop.
####### Living the colorful life #######

User avatar
rbytes
Posts: 1938
Joined: Sun May 31, 2015 12:11 am
My devices: iPhone X
iPad 4
MacBook
Dell Inspiron laptop
CHUWI Plus 10 convertible Windows/Android tablet
Location: Calgary, Canada
Flag: Canada
Contact:

Parser

Post by rbytes » Sun Apr 14, 2019 3:51 am

Here is a program named Parser that scans a text file and removes words that are deemed unsuitable for a word cloud. At the end, array G$ is filled with the suitable words. More work is needed, because some words need to stay in groups to retain their combined meaning. Some hyphenated examples are shown. Character 160 could also be inserted between words to keep them in groups.

Code: Select all

/*
Parser by rbytes
April 2019
removes non-essential words from a text file, leaving key descriptive words
*/

a$="4K STUNNING VIDEO & PICTURES with breathtaking 4K Ultra High Definition and ultra-clear 13-megapixel stills. EASY-TO-USE no flying experience necessary to take dramatic aerial group photos and video, simply pick from 5 automated flight modes to get the shot of your choice: Selfie, Pilot, Orbit, Journey, Follow Me. SAFE TO FLY with built-in Indoor Positioning System to allow Breeze to hold its position indoors and outdoors; the propeller protectors preventing them from coming into contact with other objects. Also, automatically returns to home and lands with the tap of a button. SOCIAL Download the app on your mobile device to control and navigate Breeze, edit photos & videos, then instantly share to your favorite social media sites. PORTABLE & LIGHTWEIGHT Compact and on-the-go, foldable propellers, this powerful flying camera drone weighs less than 1 pound and easy to carry."
PRINT a$
PRINT


' remove commas

flag=1
WHILE INSTR(a$,",",flag)>-1
  temp=INSTR(a$,",",flag)
  a1$=MID$(a$,0,temp)
  a2$=MID$(a$,temp+1,2000)
  a$=a1$&a2$
  flag=temp+1
END WHILE

a$=LOWSTR$(a$)
PRINT a$


' create a string array containing the desired text

SPLIT A$ TO M$,N WITH " "


' eliminate capitalization of the first word (will need to be done at start of each sentence)

M$(0)= LOWSTR$ (M$(0))


' create a string array of words to remove

P$="to|from|with|a|the|in|into|also|other|get|take|keep|each|us|allow|permit|enable|let|me|no|any|less|more|than|lesser|because|greater|them|also|&|this|that|of|your|their|his|it|its|hers|his|theirs|because|besides|then|now|an|and|that|it|they|he|she|is|must|shall|unless|until|was|on|under|above|beside|out|in|up|down|0|1|2|3|4|5|6|7|8|9|10"

SPLIT P$ TO K$,L WITH "|"


' erase the less-desirable words from the M$ text array

FOR t=0 TO L-1
  FOR u = 0 TO N-1
    IF M$(u)=K$(t) OR RIGHT$(M$(u),2)="ly" THEN M$(u)=""         ' eliminate adverbs
    IF RIGHT$(M$(u),1)="." OR RIGHT$(M$(u),1)=";" OR RIGHT$(M$(u),1)=":" THEN M$(u)=LEFT$(M$(u),LEN(M$(u))-1)  ' remove periods, semicolons and colons
  NEXT u
NEXT t
PRINT


' eliminate duplicates

FOR t=0 TO N-1
  FOR u = 0 TO N-1
    IF M$(u)=M$(t) AND t<>u THEN M$(u)=""
  NEXT u
NEXT t


' print the desired words

cnt=0
FOR u=0 TO N-1
  IF M$(u)<>"" THEN
    PRINT M$(u)
    cnt+=1
  ENDIF
NEXT u


' store the key words in a new array

DIM G$(cnt)
cnt=0
FOR u=0 TO N-1
  IF M$(u)<>"" THEN
    G$(cnt)=M$(u)
    cnt+=1
  ENDIF
NEXT u


PAUSE 5
Attachments
99E1570C-C806-4498-8315-1DA4EEB7E96A.png
99E1570C-C806-4498-8315-1DA4EEB7E96A.png (339.44 KiB) Viewed 130 times
D74EBF31-A43D-4840-ABD5-5B3E262781C1.png
D74EBF31-A43D-4840-ABD5-5B3E262781C1.png (137.61 KiB) Viewed 130 times
####### Living the colorful life #######

Henko
Posts: 849
Joined: Tue Apr 09, 2013 12:23 pm
My devices: iPhone,iPad
Windows
Location: Groningen, Netherlands
Flag: Netherlands

Re: Word Cloud

Post by Henko » Sun Apr 14, 2019 6:17 pm

I made some adaptations in the code to make it faster. With the present test data both programs take very short time, but with larger files the speed difference (a factor 6) may be of value.
The main thing was to sort the arrays, which permits more efficient processing.

Code: Select all

' read text file and rejectables file and sort the 2 tables

file "parser_reject.txt" input p$   ' input array with words to remove
SPLIT P$ TO K$,L WITH "|" ! sort k$
sep$=" ,.:;&"                       ' input text to be parsed
file "parser_text.txt" input a$ ! a$=lowstr$(a$)
SPLIT a$ TO m$,n WITH sep$ ! sort m$ ! print a$ ! print

' eliminate duplicates and adverbs
k=0
for i=1 to N-1 ! z$=m$(i)
  if z$=m$(k) or RIGHT$(z$,2)="ly" then continue
  k+=1 ! m$(k)=z$
  next i
N=k+1

' eliminate rejectables
k=-1
for i=0 to N-1 ! z$=m$(i)
  reject=0
  for j=0 to L-1
    if z$<K$(j) then break
    if z$=K$(j) then ! reject=1 ! break ! end if
    next j
  if reject then continue
  k+=1 ! m$(k)=z$
  next i
N=k+1

FOR u=0 TO N-1 ! PRINT M$(u) ! NEXT u    ' print the desired words

PAUSE 5

User avatar
rbytes
Posts: 1938
Joined: Sun May 31, 2015 12:11 am
My devices: iPhone X
iPad 4
MacBook
Dell Inspiron laptop
CHUWI Plus 10 convertible Windows/Android tablet
Location: Calgary, Canada
Flag: Canada
Contact:

Re: Word Cloud

Post by rbytes » Wed Apr 17, 2019 1:49 pm

Nice improvements. I will try to adapt it for Word Cloud.

I will sort the rejected word array, but won't sort the desired words, because they need to stay in priority order to display from large to small size.
####### Living the colorful life #######

Post Reply