Rebus generator

User projects written in or related to FreeBASIC.
badidea
Posts: 1766
Joined: May 24, 2007 22:10
Location: The Netherlands

Rebus generator

Postby badidea » Jan 20, 2020 0:00

Update: https://github.com/verybadidea/rebus_generator

Not sure if "projects" is the right place. Anyway, Inspired by this Rebus generator I am trying to make something similar. For now with text only, but all the keywords are descriptions of emoji characters. Using emoji characters with freebasic or the forum does not work well, so I'll probably have to use image versions of these characters later.

Code so far (more stuff to fix and add):

Code: Select all

'steps:
' find direct match -> done
' find mutated match -> done
' find match with deleted char -> done
' find partial direct match -> remainder
' find partial mutated match -> remainder
' find partial match with deleted char -> remainder

'bugs / todo:
' repeat with remaining parts
' repeat with next word

'done:
' do not allow: T + TRAIN (-T) or T + TRAIN (-T)

function quote(str1 as string) as string
   return chr(34) + str1 + chr(34)
end function

sub ucaseList(listStr() as string)
   for i as integer = 0 to ubound(listStr)
      listStr(i) = ucase(listStr(i))
   next
end sub

'Note: Uses first char pos = 0
function cutChar(text as string, charPos as integer) as string
   return mid(text, 1, charPos) & mid(text, charPos + 2)
end function

sub colorPrint(text as string, fc as integer)
   color fc, 0
   print text
   color 15, 0
end sub

dim as string emojiListStr(...) = _
   {"Clown","Skull","Alien","Robot","Poo","Baby","Boy","Girl","Farmer","Cook",_
    "Pilot","Police","Mage","Fairy","Elf","Genie","Zombie","Dance","Bath",_
    "Bed","Rowing","Skier","Swim","Kiss","Selfie","Ok","Fist","Wave","Ear",_
    "Nose","Eyes","Eye","Brain","Tongue","Mouth","Bomb","Hole","Glasses",_
    "Jeans","Scarf","Coat","Socks","Dress","Bikini","Shoe","Crown","Boot",_
    "Hat","Cap","Ring","Monkey","Dog","Wolf","Fox","Cat","Lion","Tiger",_
    "Horse","Zebra","Deer","Cow","Pig","Boar","Ram","Goat","Camel","Giraffe",_
    "Elephant","Rhino","Mouse","Rabbit","Bat","Bear","Koala","Panda","Turkey",_
    "Chick","Bird","Penguin","Dove","Eagle","Duck","Owl","Frog","Turtle",_
    "Lizard","Snake","Dragon","Whale","Dolphin","Fish","Shark","Octopus",_
    "Crab","Shrimp","Squid","Snail","Ant","Bee","Cricket","Spider","Web",_
    "Scorpion","Rose","Tulip","Palm","Cactus","Grapes","Melon","Lemon",_
    "Banana","Apple","Pear","Kiwi","Tomato","Coconut","Avocado","Potato",_
    "Carrot","Broccoli","Mushroom","Peanuts","Bread","Pretzel","Cheese",_
    "Meat","Bacon","Hamburger","Fries","Pizza","Egg","Salad","Popcorn",_
    "Sushi","Cookie","Cake","Candy","Honey","Coffee","Wine","Beer","Cup",_
    "Spoon","Knife","Earth","Map","Japan","Mountain","Volcano","Beach",_
    "Desert","Island","House","Hospital","Bank","School","Castle","Church",_
    "Mosque","Fountain","Tent","Sunrise","Sunset","Train","Metro","Tram",_
    "Bus","Ambulance","Taxi","Car","Truck","Tractor","Bicycle","Scooter",_
    "Railway","Anchor","Canoe","Boat","Ship","Airplane","Seat","Helicopter",_
    "Satellite","Rocket","Hourglass","Watch","Clock","Moon","Sun","Star",_
    "Cloud","Rain","Tornado","Rainbow","Umbrella","Snowman","Fire","Droplet",_
    "Balloon","Ribbon","Ticket","Trophy","Medal","Tennis","Bowling","Hockey",_
    "Goal","Skis","Joystick","Spade","Heart","Diamond","Club","Horn","Bell",_
    "Note","Microphone","Headphone","Radio","Saxophone","Guitar","Trumpet",_
    "Violin","Drum","Telephone","Battery","Laptop","Printer","Keyboard",_
    "Floppy","Television","Camera","Candle","Book","Scroll","Newspaper",_
    "Label","Money","Dollar","Envelope","Mailbox","Postbox","Pencil","Pen",_
    "Memo","Briefcase","Calendar","Paperclip","Ruler","Scissors","Key","Hammer",_
    "Pick","Pistol","Shield","Wrench","Chains","Microscope","Telescope","Pill",_
    "Door","Toilet","Shower","Cigarette","Coffin","Restroom","Warning",_
    "Radioactive","Biohazard","Up","Right","Down","Left","Turn","Atom","Peace",_
    "Aries","Taurus","Gemini","Cancer","Leo","Virgo","Libra","Scorpio",_
    "Sagittarius","Capricorn","Aquarius","Pisces","Ophiuchus","Play","Forward",_
    "Next","Reverse","Last","Pause","Eject","Female","Male","Medical",_
    "Infinity","Recycling","Trident","Triangle","Flag","Pirate","Cross",_
    "Plus","Minus","Division","Question","Information","Parking"}
dim as string emojiAssist(...) = _
   {"0","1","2","3","4","5","6","7","8","9","10",_
    "A","B","C","D","E","F","G","H","I","J","K","L","M",_
    "N","O","P","Q","R","S","T","U","V","W","X","Y","Z"}
dim as string wordList(...) = {"Training", "FreeBASIC", "Welcome", "badidea", "coderJeff", "Programming", "Forum"}
dim as integer iWord, wordLen, iEmoji, emojiLen, mutatedLen
dim as string emojiStr, mutatedStr, partStr, wordStr, logStr

'convert all to ucase
ucaseList(emojiListStr())
ucaseList(wordList())

wordStr = wordList(0) 'run with word in list for now
colorPrint("Word to match: " & quote(wordStr), 10)
wordLen = len(wordStr)

colorPrint("1. find direct match", 14) 'TRAIN = TRAIN
for iEmoji = 0 to ubound(emojiListStr)
   emojiStr = emojiListStr(iEmoji)
   if emojiStr = wordStr then
      print emojiStr
   end if
next
colorPrint("2. find direct mutated match", 14) 'TRAIN -> TRAIL
for iEmoji = 0 to ubound(emojiListStr)
   emojiStr = emojiListStr(iEmoji)
   for charPos as integer = 0 to len(emojiStr) - 1
      mutatedStr = emojiStr
      for char as integer = asc("A") to asc("Z")
         if char <> emojiStr[charPos] then
            mutatedStr[charPos] = char
            if mutatedStr = wordStr then
               print emojiStr & "->" & mutatedStr & " (" & chr(emojiStr[charPos]) & "=" & chr(char) & ")"
            end if
         end if
      next
   next
next
colorPrint("3. find match with deleted char", 14) 'TRAIN -> TRAN
for iEmoji = 0 to ubound(emojiListStr)
   emojiStr = emojiListStr(iEmoji)
   for charPos as integer = 0 to len(emojiStr) - 1
      mutatedStr = cutChar(emojiStr, charPos)
      if mutatedStr = wordStr then
         print emojiStr & "->" & mutatedStr & " (-" & chr(emojiStr[charPos]) & ")"
      end if
   next
next
colorPrint("4. find partial direct match", 14) 'TRAIN + ING
for iEmoji = 0 to ubound(emojiListStr)
   emojiStr = emojiListStr(iEmoji)
   emojiLen = len(emojiStr)
   if emojiLen < wordLen then
      for strPos as integer = 0 to wordLen - emojiLen
         partStr = mid(wordStr, strPos + 1, emojiLen)
         if partStr = emojiStr then
            dim as string beforeStr = mid(wordStr, 1, strPos)
            dim as string afterStr = mid(wordStr, strPos + emojiLen + 1)
            print iif(beforeStr = "", "", beforeStr & " + ") & partStr & iif(afterStr = "", "", " + " & afterStr)
         end if
      next
   end if
next
colorPrint("5. find partial mutated match", 14) 'TRAM (M=I) + RING (R=N)
for iEmoji = 0 to ubound(emojiListStr)
   emojiStr = emojiListStr(iEmoji)
   emojiLen = len(emojiStr)
   if emojiLen < wordLen then
      for strPos as integer = 0 to wordLen - emojiLen
         partStr = mid(wordStr, strPos + 1, emojiLen)
         for charPos as integer = 0 to len(emojiStr) - 1
            mutatedStr = emojiStr
            for char as integer = asc("A") to asc("Z")
               if char <> emojiStr[charPos] then
                  mutatedStr[charPos] = char
                  if mutatedStr = partStr then
                     logStr = emojiStr & " (" & chr(emojiStr[charPos]) & "=" & chr(char) & ")"
                     dim as string beforeStr = mid(wordStr, 1, strPos)
                     dim as string afterStr = mid(wordStr, strPos + emojiLen + 1)
                     print iif(beforeStr = "", "", beforeStr & " + ") & logStr & iif(afterStr = "", "", " + " & afterStr)
                  end if
               end if
            next
         next
      next
   end if
next
colorPrint("6. find partial match with deleted char", 14) 'T + BRAIN (-B) + ING
for iEmoji = 0 to ubound(emojiListStr)
   emojiStr = emojiListStr(iEmoji)
   emojiLen = len(emojiStr)
   mutatedLen = emojiLen - 1
   for charPos as integer = 0 to emojiLen - 1
      mutatedStr = cutChar(emojiStr, charPos)
      if mutatedLen < wordLen then
         for strPos as integer = 0 to wordLen - mutatedLen
            partStr = mid(wordStr, strPos + 1, mutatedLen)
            if partStr = mutatedStr then
               dim as string beforeStr = mid(wordStr, 1, strPos)
               dim as string afterStr = mid(wordStr, strPos + mutatedLen + 1)
               dim as string delCharStr = chr(emojiStr[charPos])
               if charPos = 0 andalso delCharStr = right(beforeStr, 1) then continue for
               if charPos = emojiLen - 1 andalso delCharStr = left(afterStr, 1) then continue for
               logStr = emojiStr & " (-" & delCharStr & ")"
               print iif(beforeStr = "", "", beforeStr & " + ") & logStr & iif(afterStr = "", "", " + " & afterStr)
            end if
         next
      end if
   next
next

Enough nested loops for today.

Edit: updated (22:39:01 UTC, Monday, 20 January 2020)
Last edited by badidea on Feb 02, 2020 0:30, edited 1 time in total.
badidea
Posts: 1766
Joined: May 24, 2007 22:10
Location: The Netherlands

Re: Rebus generator

Postby badidea » Jan 21, 2020 22:49

Recursion added, but the end-results still need to be saved in some memory structure. Currently it produces something that looks like gibberish.

Code: Select all

'steps:
' find direct match -> done
' find mutated match -> done
' find match with deleted char -> done
' find partial direct match -> remainder
' find partial mutated match -> remainder
' find partial match with deleted char -> remainder

'bugs / todo:
' build solution list and filter doubles
' perform on sentence
' remove long and uncommon emoji strings
' add emoji images

'done:
' do not allow T + TRAIN (-T) or T + TRAIN (-T)
' do not use F + OK (-K) + R use F + OK (K=R)
' repeat with remaining parts

declare sub rebusify(wordStr as string, emojiListStr() as string)

function quote(str1 as string) as string
   return chr(34) + str1 + chr(34)
end function

sub ucaseList(listStr() as string)
   for i as integer = 0 to ubound(listStr)
      listStr(i) = ucase(listStr(i))
   next
end sub

'Note: Uses first char pos = 0
function cutChar(text as string, charPos as integer) as string
   return mid(text, 1, charPos) & mid(text, charPos + 2)
end function

sub colorPrint(text as string, fc as integer)
   color fc, 0
   print text
   color 15, 0
end sub

dim as string emojiListStr(...) = _
   {"Clown","Skull","Alien","Robot","Poo","Baby","Boy","Girl","Farmer","Cook",_
    "Pilot","Police","Mage","Fairy","Elf","Genie","Zombie","Dance","Bath",_
    "Bed","Rowing","Skier","Swim","Kiss","Selfie","Ok","Fist","Wave","Ear",_
    "Nose","Eyes","Eye","Brain","Tongue","Mouth","Bomb","Hole","Glasses",_
    "Jeans","Scarf","Coat","Socks","Dress","Bikini","Shoe","Crown","Boot",_
    "Hat","Cap","Ring","Monkey","Dog","Wolf","Fox","Cat","Lion","Tiger",_
    "Horse","Zebra","Deer","Cow","Pig","Boar","Ram","Goat","Camel","Giraffe",_
    "Elephant","Rhino","Mouse","Rabbit","Bat","Bear","Koala","Panda","Turkey",_
    "Chick","Bird","Penguin","Dove","Eagle","Duck","Owl","Frog","Turtle",_
    "Lizard","Snake","Dragon","Whale","Dolphin","Fish","Shark","Octopus",_
    "Crab","Shrimp","Squid","Snail","Ant","Bee","Cricket","Spider","Web",_
    "Scorpion","Rose","Tulip","Palm","Cactus","Grapes","Melon","Lemon",_
    "Banana","Apple","Pear","Kiwi","Tomato","Coconut","Avocado","Potato",_
    "Carrot","Broccoli","Mushroom","Peanuts","Bread","Pretzel","Cheese",_
    "Meat","Bacon","Hamburger","Fries","Pizza","Egg","Salad","Popcorn",_
    "Sushi","Cookie","Cake","Candy","Honey","Coffee","Wine","Beer","Cup",_
    "Spoon","Knife","Earth","Map","Japan","Mountain","Volcano","Beach",_
    "Desert","Island","House","Hospital","Bank","School","Castle","Church",_
    "Mosque","Fountain","Tent","Sunrise","Sunset","Train","Metro","Tram",_
    "Bus","Ambulance","Taxi","Car","Truck","Tractor","Bicycle","Scooter",_
    "Railway","Anchor","Canoe","Boat","Ship","Airplane","Seat","Helicopter",_
    "Satellite","Rocket","Hourglass","Watch","Clock","Moon","Sun","Star",_
    "Cloud","Rain","Tornado","Rainbow","Umbrella","Snowman","Fire","Droplet",_
    "Balloon","Ribbon","Ticket","Trophy","Medal","Tennis","Bowling","Hockey",_
    "Goal","Skis","Joystick","Spade","Heart","Diamond","Club","Horn","Bell",_
    "Note","Microphone","Headphone","Radio","Saxophone","Guitar","Trumpet",_
    "Violin","Drum","Telephone","Battery","Laptop","Printer","Keyboard",_
    "Floppy","Television","Camera","Candle","Book","Scroll","Newspaper",_
    "Label","Money","Dollar","Envelope","Mailbox","Postbox","Pencil","Pen",_
    "Memo","Briefcase","Calendar","Paperclip","Ruler","Scissors","Key","Hammer",_
    "Pick","Pistol","Shield","Wrench","Chains","Microscope","Telescope","Pill",_
    "Door","Toilet","Shower","Cigarette","Coffin","Restroom","Warning",_
    "Radioactive","Biohazard","Up","Right","Down","Left","Turn","Atom","Peace",_
    "Aries","Taurus","Gemini","Cancer","Leo","Virgo","Libra","Scorpio",_
    "Sagittarius","Capricorn","Aquarius","Pisces","Ophiuchus","Play","Forward",_
    "Next","Reverse","Last","Pause","Eject","Female","Male","Medical",_
    "Infinity","Recycling","Trident","Triangle","Flag","Pirate","Cross",_
    "Plus","Minus","Division","Question","Information","Parking"}
dim as string emojiAssist(...) = _
   {"0","1","2","3","4","5","6","7","8","9","10",_
    "A","B","C","D","E","F","G","H","I","J","K","L","M",_
    "N","O","P","Q","R","S","T","U","V","W","X","Y","Z"}
dim as string wordList(...) = {"example", "Training", "FreeBASIC", "Welcome", "badidea", "coderJeff", "Programming", "Forum"}

'convert all to ucase
ucaseList(emojiListStr())
ucaseList(wordList())

dim as string wordStr
wordStr = wordList(0) 'run with word in list for now
colorPrint("Word to match: " & quote(wordStr), 10)
rebusify(wordStr, emojiListStr())
end

sub rebusify(wordStr as string, emojiListStr() as string)
   dim as integer iWord, wordLen, iEmoji, emojiLen, mutatedLen
   dim as string emojiStr, mutatedStr, partStr, logStr
   static as integer recursiveDepth = 0
   dim as string indent = string(recursiveDepth * 2, " ")
   '
   recursiveDepth += 1
   wordLen = len(wordStr)
   'colorPrint(indent & "1. find direct match", 14) 'TRAIN = TRAIN
   for iEmoji = 0 to ubound(emojiListStr)
      emojiStr = emojiListStr(iEmoji)
      if emojiStr = wordStr then
         print indent & emojiStr
      end if
   next
   'colorPrint(indent & "2. find direct mutated match", 14) 'TRAIN -> TRAIL
   for iEmoji = 0 to ubound(emojiListStr)
      emojiStr = emojiListStr(iEmoji)
      for charPos as integer = 0 to len(emojiStr) - 1
         mutatedStr = emojiStr
         for char as integer = asc("A") to asc("Z")
            if char <> emojiStr[charPos] then
               mutatedStr[charPos] = char
               if mutatedStr = wordStr then
                  print indent & emojiStr & " (" & chr(emojiStr[charPos]) & "=" & chr(char) & ")"
               end if
            end if
         next
      next
   next
   'colorPrint(indent & "3. find match with deleted char", 14) 'TRAIN -> TRAN
   for iEmoji = 0 to ubound(emojiListStr)
      emojiStr = emojiListStr(iEmoji)
      for charPos as integer = 0 to len(emojiStr) - 1
         mutatedStr = cutChar(emojiStr, charPos)
         if mutatedStr = wordStr then
            print indent & emojiStr & " (-" & chr(emojiStr[charPos]) & ")"
         end if
      next
   next
   'colorPrint(indent & "4. find partial direct match", 14) 'TRAIN + ING
   for iEmoji = 0 to ubound(emojiListStr)
      emojiStr = emojiListStr(iEmoji)
      emojiLen = len(emojiStr)
      if emojiLen < wordLen then
         for strPos as integer = 0 to wordLen - emojiLen
            partStr = mid(wordStr, strPos + 1, emojiLen)
            if partStr = emojiStr then
               dim as string beforeStr = mid(wordStr, 1, strPos)
               dim as string afterStr = mid(wordStr, strPos + emojiLen + 1)
               print indent & iif(beforeStr = "", "", beforeStr & " + ") & partStr & iif(afterStr = "", "", " + " & afterStr)
               if len(beforeStr) >= 2 then rebusify(beforeStr, emojiListStr())
               if len(afterStr) >= 2 then rebusify(afterStr, emojiListStr())
            end if
         next
      end if
   next
   'colorPrint(indent & "5. find partial mutated match", 14) 'TRAM (M=I) + RING (R=N)
   for iEmoji = 0 to ubound(emojiListStr)
      emojiStr = emojiListStr(iEmoji)
      emojiLen = len(emojiStr)
      if emojiLen < wordLen then
         for strPos as integer = 0 to wordLen - emojiLen
            partStr = mid(wordStr, strPos + 1, emojiLen)
            for charPos as integer = 0 to len(emojiStr) - 1
               mutatedStr = emojiStr
               for char as integer = asc("A") to asc("Z")
                  if char <> emojiStr[charPos] then
                     mutatedStr[charPos] = char
                     if mutatedStr = partStr then
                        logStr = emojiStr & " (" & chr(emojiStr[charPos]) & "=" & chr(char) & ")"
                        dim as string beforeStr = mid(wordStr, 1, strPos)
                        dim as string afterStr = mid(wordStr, strPos + emojiLen + 1)
                        print indent & iif(beforeStr = "", "", beforeStr & " + ") & logStr & iif(afterStr = "", "", " + " & afterStr)
                        if len(beforeStr) >= 2 then rebusify(beforeStr, emojiListStr())
                        if len(afterStr) >= 2 then rebusify(afterStr, emojiListStr())
                     end if
                  end if
               next
            next
         next
      end if
   next
   'colorPrint(indent & "6. find partial match with deleted char", 14) 'T + BRAIN (-B) + ING
   for iEmoji = 0 to ubound(emojiListStr)
      emojiStr = emojiListStr(iEmoji)
      emojiLen = len(emojiStr)
      mutatedLen = emojiLen - 1
      for charPos as integer = 0 to emojiLen - 1
         mutatedStr = cutChar(emojiStr, charPos)
         if mutatedLen < wordLen then
            for strPos as integer = 0 to wordLen - mutatedLen
               partStr = mid(wordStr, strPos + 1, mutatedLen)
               if partStr = mutatedStr then
                  dim as string beforeStr = mid(wordStr, 1, strPos)
                  dim as string afterStr = mid(wordStr, strPos + mutatedLen + 1)
                  dim as string delCharStr = chr(emojiStr[charPos])
                  'do not allow T + TRAIN (-T) or T + TRAIN (-T)
                  'do not use F + OK (-K) + R use F + OK (K=R)
                  if charPos = 0 andalso len(beforeStr) = 1 then continue for
                  if charPos = emojiLen - 1 andalso len(afterStr) = 1 then continue for
                  logStr = emojiStr & " (-" & delCharStr & ")"
                  print indent & iif(beforeStr = "", "", beforeStr & " + ") & logStr & iif(afterStr = "", "", " + " & afterStr)
                  if len(beforeStr) >= 2 then rebusify(beforeStr, emojiListStr())
                  if len(afterStr) >= 2 then rebusify(afterStr, emojiListStr())
               end if
            next
         end if
      next
   next
   recursiveDepth -= 1
end sub
paul doe
Posts: 1061
Joined: Jul 25, 2017 17:22
Location: Argentina

Re: Rebus generator

Postby paul doe » Jan 21, 2020 23:04

Wow, super nice. Almost (just add pictures) a complete Rebus generator ;)
badidea
Posts: 1766
Joined: May 24, 2007 22:10
Location: The Netherlands

Re: Rebus generator

Postby badidea » Jan 26, 2020 20:46

The recursive rebus generator is one big ugly monster now, but it does the job.

Code: Select all

'steps:
' find direct match -> done
' find mutated match -> done
' find match with deleted char -> done
' find partial direct match -> remainder
' find partial mutated match -> remainder
' find partial match with deleted char -> remainder
' remove doubles and sort
' remove lesser solutions

'todo:
' remove long and uncommon emoji strings
' add emoji images
' convert output string to images with text

'-------------------------------------------------------------------------------

function quote(str1 as string) as string
   return chr(34) + str1 + chr(34)
end function

sub ucaseList(listStr() as string)
   for i as integer = 0 to ubound(listStr)
      listStr(i) = ucase(listStr(i))
   next
end sub

'Note: Uses first char pos = 0
function cutChar(text as string, charPos as integer) as string
   return mid(text, 1, charPos) & mid(text, charPos + 2)
end function

sub colorPrint(text as string, fc as integer)
   color fc, 0
   print text
   color 15, 0
end sub

'concatenate with smart token insertion
function tokcat(str1 as string = "", str2 as string = "", str3 as string = "", str4 as string = "", str5 as string = "") as string
   dim as string retStr = ""
   if len(str1) <> 0 then retStr &= iif(len(retStr) = 0, str1, " + " & str1)
   if len(str2) <> 0 then retStr &= iif(len(retStr) = 0, str2, " + " & str2)
   if len(str3) <> 0 then retStr &= iif(len(retStr) = 0, str3, " + " & str3)
   if len(str4) <> 0 then retStr &= iif(len(retStr) = 0, str4, " + " & str4)
   if len(str5) <> 0 then retStr &= iif(len(retStr) = 0, str5, " + " & str5)
   return retStr
end function

'concatenate with dump token insertion
function simplecat(str1 as string = "", str2 as string = "", str3 as string = "", str4 as string = "", str5 as string = "") as string
   dim as string retStr = ""
   retStr &= str1
   retStr &= " + " & str2
   retStr &= " + " & str3
   retStr &= " + " & str4
   retStr &= " + " & str5
   return retStr
end function

'count chars in string
function countInStr(text as string, charStr as string) as integer
   dim as ubyte char = charStr[0]
   dim as integer count = 0
   for i as integer = 0 to len(text) - 1
      if text[i] = char then count += 1
   next
   return count
end function

'count capitals in string
function countCapStr(text as string) as integer
   dim as integer count = 0
   for i as integer = 0 to len(text) - 1
      if text[i] >= asc("A") and text[i] <= asc("Z") then count += 1
   next
   return count
end function

'-------------------------------------------------------------------------------

#include "crt/stdlib.bi"

'sort by name
function qSortCallback1 cdecl(str1 as string, str2 as string) as long
   if str1 < str2 then return -1
   if str1 > str2 then return +1
   return 0
end function

'sort by capital count
function qSortCallback2 cdecl(str1 as string, str2 as string) as long
   dim as integer diff = countCapStr(str1) - countCapStr(str2)
   if diff < 0 then return -1
   if diff > 0 then return +1
   return 0
end function

'-------------------------------------------------------------------------------

type string_list
   dim as string list(any)
   declare function size() as integer
   declare function empty() as integer
   declare function add(text as string) as integer
   declare function insert(text as string, position as integer) as integer
   declare function remove(position as integer) as integer
   'declare function find(text as string) as integer
   declare function clean() as integer 'remove doubles
   declare function sort() as integer
   declare sub printAll()
end type

function string_list.size() as integer
   return ubound(list) + 1
end function

function string_list.empty() as integer
   erase(list)
   return 0
end function

function string_list.add(text as string) as integer
   dim as integer ub = ubound(list)
   redim preserve list(ub + 1)
   list(ub + 1) = text
   return ub + 1
end function

function string_list.insert(text as string, position as integer) as integer
   dim as integer ub = ubound(list)
   if position < 0 then return -1
   if position > ub + 1 then return -1
   redim preserve list(ub + 1)
   for i as integer = ub to position step -1
      list(i + 1) = list(i) 'move down
   next
   list(position) = text 'insert
   return ub + 1
end function

function string_list.remove(position as integer) as integer
   dim as integer ub = ubound(list)
   if position < 0 then return -1
   if position > ub then return -1
   list(position) = list(ub) 'move last to remove position
   redim preserve list(ub - 1)
   return ub - 1
end function

'remove doubles for list
function string_list.clean() as integer
   dim as integer i, j, numRemoved = 0
   while i <= ubound(list)
      j = i + 1
      while j <= ubound(list)
         if list(i) = list(j) then
            remove(j)
            numRemoved += 1
            j -= 1
         end if
         j += 1
      wend
      i += 1
   wend
   return numRemoved
end function

function string_list.sort() as integer
   qsort(@list(0), ubound(list) + 1, sizeof(list), cptr(any ptr, @qSortCallback1))
   qsort(@list(0), ubound(list) + 1, sizeof(list), cptr(any ptr, @qSortCallback2))
   return 0
end function

sub string_list.printAll()
   for i as integer = 0 to ubound(list)
      print i & " - " & list(i)
      'print i & " - " & list(i) & " --> " & countCapStr(list(i))
   next
end sub

'-------------------------------------------------------------------------------

'call after sorting the list
sub removeLesserSolutions(strList as string_list, margin as integer)
   dim as integer minChar = countCapStr(strList.list(0))
   dim as integer i = 0
   while i <= ubound(strList.list)
      if countCapStr(strList.list(i)) > minChar + margin then
         strList.remove(i)
         i -= 1
      end if
      i += 1
   wend
end sub

'-------------------------------------------------------------------------------

dim as string emojiListStr(...) = _
   {"Clown","Skull","Alien","Robot","Poo","Baby","Boy","Girl","Farmer","Cook",_
    "Pilot","Police","Mage","Fairy","Elf","Genie","Zombie","Dance","Bath",_
    "Bed","Rowing","Skier","Swim","Kiss","Selfie","Ok","Fist","Wave","Ear",_
    "Nose","Eyes","Eye","Brain","Tongue","Mouth","Bomb","Hole","Glasses",_
    "Jeans","Scarf","Coat","Socks","Dress","Bikini","Shoe","Crown","Boot",_
    "Hat","Cap","Ring","Monkey","Dog","Wolf","Fox","Cat","Lion","Tiger",_
    "Horse","Zebra","Deer","Cow","Pig","Boar","Ram","Goat","Camel","Giraffe",_
    "Elephant","Rhino","Mouse","Rabbit","Bat","Bear","Koala","Panda","Turkey",_
    "Chick","Bird","Penguin","Dove","Eagle","Duck","Owl","Frog","Turtle",_
    "Lizard","Snake","Dragon","Whale","Dolphin","Fish","Shark","Octopus",_
    "Crab","Shrimp","Squid","Snail","Ant","Bee","Cricket","Spider","Web",_
    "Scorpion","Rose","Tulip","Palm","Cactus","Grapes","Melon","Lemon",_
    "Banana","Apple","Pear","Kiwi","Tomato","Coconut","Avocado","Potato",_
    "Carrot","Broccoli","Mushroom","Peanuts","Bread","Pretzel","Cheese",_
    "Meat","Bacon","Hamburger","Fries","Pizza","Egg","Salad","Popcorn",_
    "Sushi","Cookie","Cake","Candy","Honey","Coffee","Wine","Beer","Cup",_
    "Spoon","Knife","Earth","Map","Japan","Mountain","Volcano","Beach",_
    "Desert","Island","House","Hospital","Bank","School","Castle","Church",_
    "Mosque","Fountain","Tent","Sunrise","Sunset","Train","Metro","Tram",_
    "Bus","Ambulance","Taxi","Car","Truck","Tractor","Bicycle","Scooter",_
    "Railway","Anchor","Canoe","Boat","Ship","Airplane","Seat","Helicopter",_
    "Satellite","Rocket","Hourglass","Watch","Clock","Moon","Sun","Star",_
    "Cloud","Rain","Tornado","Rainbow","Umbrella","Snowman","Fire","Droplet",_
    "Balloon","Ribbon","Ticket","Trophy","Medal","Tennis","Bowling","Hockey",_
    "Goal","Skis","Joystick","Spade","Heart","Diamond","Club","Horn","Bell",_
    "Note","Microphone","Headphone","Radio","Saxophone","Guitar","Trumpet",_
    "Violin","Drum","Telephone","Battery","Laptop","Printer","Keyboard",_
    "Floppy","Television","Camera","Candle","Book","Scroll","Newspaper",_
    "Label","Money","Dollar","Envelope","Mailbox","Postbox","Pencil","Pen",_
    "Memo","Briefcase","Calendar","Paperclip","Ruler","Scissors","Key","Hammer",_
    "Pick","Pistol","Shield","Wrench","Chains","Microscope","Telescope","Pill",_
    "Door","Toilet","Shower","Cigarette","Coffin","Restroom","Warning",_
    "Radioactive","Biohazard","Up","Right","Down","Left","Turn","Atom","Peace",_
    "Aries","Taurus","Gemini","Cancer","Leo","Virgo","Libra","Scorpio",_
    "Sagittarius","Capricorn","Aquarius","Pisces","Ophiuchus","Play","Forward",_
    "Next","Reverse","Last","Pause","Eject","Female","Male","Medical",_
    "Infinity","Recycling","Trident","Triangle","Flag","Pirate","Cross",_
    "Plus","Minus","Division","Question","Information","Parking"}
dim as string emojiAssist(...) = _
   {"0","1","2","3","4","5","6","7","8","9","10",_
    "A","B","C","D","E","F","G","H","I","J","K","L","M",_
    "N","O","P","Q","R","S","T","U","V","W","X","Y","Z"}
dim as string wordList(...) = _
   {"voyager", "enterprise", "rebus", "Examples", "Training", "FreeBASIC", _
    "Welcome", "badidea", "coderJeff", "dodicat", "Forum", "coding", "Programming"}
declare sub rebusify(preStr as string, wordStr as string, postStr as string, emojiListStr() as string)

dim shared as string_list rebusList

'convert all to ucase
ucaseList(emojiListStr())
ucaseList(wordList())

dim as string wordStr
for i as integer = 0 to ubound(wordList)
   wordStr = ucase(wordList(i))
   colorPrint("Word to match: " & quote(wordStr), 10)
   rebusList.empty()
   rebusify("", wordStr, "", emojiListStr())
   rebusList.clean()
   rebusList.sort()
   removeLesserSolutions(rebusList, 0)
   rebusList.printAll()
next
end

sub rebusify(preStr as string, wordStr as string, postStr as string, emojiListStr() as string)
   dim as integer wordLen, iEmoji, emojiLen, mutatedLen, nothing = 1
   dim as string emojiStr, mutatedStr, partStr, rebusStr
   dim as string beforeStr, afterStr
   static as integer recursiveDepth = 0
   dim as string indent = string(recursiveDepth * 2, " ")
   recursiveDepth += 1
   wordLen = len(wordStr)
   'colorPrint(indent & "1. find direct match", 14) 'TRAIN = TRAIN
   for iEmoji = 0 to ubound(emojiListStr)
      emojiStr = emojiListStr(iEmoji)
      if emojiStr = wordStr then
         rebusStr = lcase(emojiStr)
         'print indent & rebusStr
         rebusList.add(tokcat(preStr, rebusStr, postStr))
         nothing = 0
      end if
   next
   'colorPrint(indent & "2. find direct mutated match", 14) 'TRAIN -> TRAIL
   for iEmoji = 0 to ubound(emojiListStr)
      emojiStr = emojiListStr(iEmoji)
      for charPos as integer = 0 to len(emojiStr) - 1
         mutatedStr = emojiStr
         for char as integer = asc("A") to asc("Z")
            if char <> emojiStr[charPos] then
               mutatedStr[charPos] = char
               if mutatedStr = wordStr then
                  rebusStr = lcase(emojiStr & " (" & chr(emojiStr[charPos]) & "=" & chr(char) & ")")
                  'print indent & rebusStr
                  rebusList.add(tokcat(preStr, rebusStr, postStr))
                  nothing = 0
               end if
            end if
         next
      next
   next
   'colorPrint(indent & "3. find match with deleted char", 14) 'TRAIN -> TRAN
   for iEmoji = 0 to ubound(emojiListStr)
      emojiStr = emojiListStr(iEmoji)
      for charPos as integer = 0 to len(emojiStr) - 1
         mutatedStr = cutChar(emojiStr, charPos)
         if mutatedStr = wordStr then
            rebusStr = lcase(emojiStr & " (-" & chr(emojiStr[charPos]) & ")")
            'print indent & rebusStr
            rebusList.add(tokcat(preStr, rebusStr, postStr))
            nothing = 0
         end if
      next
   next
   'colorPrint(indent & "4. find partial direct match", 14) 'TRAIN + ING
   for iEmoji = 0 to ubound(emojiListStr)
      emojiStr = emojiListStr(iEmoji)
      emojiLen = len(emojiStr)
      if emojiLen < wordLen then
         for strPos as integer = 0 to wordLen - emojiLen
            partStr = mid(wordStr, strPos + 1, emojiLen)
            if partStr = emojiStr then
               rebusStr = lcase(emojiStr)
               beforeStr = mid(wordStr, 1, strPos)
               afterStr = mid(wordStr, strPos + emojiLen + 1)
               'print indent & tokcat(beforeStr, rebusStr, afterStr)
               'colorPrint(indent + simplecat(preStr, beforeStr, rebusStr, afterStr, postStr), 12)
               if len(beforeStr) >= 2 then
                  rebusify(preStr, beforeStr, tokcat(rebusStr, afterStr, postStr), emojiListStr())
               end if
               if len(afterStr) >= 2 then
                  rebusify(tokcat(preStr, beforeStr, rebusStr), afterStr, postStr, emojiListStr())
               end if
               if len(beforeStr) < 2 and len(afterStr) < 2 then
                  rebusList.add(tokcat(preStr, beforeStr, rebusStr, afterStr, postStr))
               end if
               nothing = 0
            end if
         next
      end if
   next
   'colorPrint(indent & "5. find partial mutated match", 14) 'TRAM (M=I) + RING (R=N)
   for iEmoji = 0 to ubound(emojiListStr)
      emojiStr = emojiListStr(iEmoji)
      emojiLen = len(emojiStr)
      if emojiLen < wordLen then
         for strPos as integer = 0 to wordLen - emojiLen
            partStr = mid(wordStr, strPos + 1, emojiLen)
            for charPos as integer = 0 to len(emojiStr) - 1
               mutatedStr = emojiStr
               for char as integer = asc("A") to asc("Z")
                  if char <> emojiStr[charPos] then
                     mutatedStr[charPos] = char
                     if mutatedStr = partStr then
                        rebusStr = lcase(emojiStr & " (" & chr(emojiStr[charPos]) & "=" & chr(char) & ")")
                        beforeStr = mid(wordStr, 1, strPos)
                        afterStr = mid(wordStr, strPos + emojiLen + 1)
                        'print indent & tokcat(beforeStr, rebusStr, afterStr)
                        'colorPrint(indent + simplecat(preStr, beforeStr, rebusStr, afterStr, postStr), 13)
                        if len(beforeStr) >= 2 then
                           rebusify(preStr, beforeStr, tokcat(rebusStr, afterStr, postStr), emojiListStr())
                        end if
                        if len(afterStr) >= 2 then
                           rebusify(tokcat(preStr, beforeStr, rebusStr), afterStr, postStr, emojiListStr())
                        end if
                        if len(beforeStr) < 2 and len(afterStr) < 2 then
                           rebusList.add(tokcat(preStr, beforeStr, rebusStr, afterStr, postStr))
                        end if
                        nothing = 0
                     end if
                  end if
               next
            next
         next
      end if
   next
   'colorPrint(indent & "6. find partial match with deleted char", 14) 'T + BRAIN (-B) + ING
   for iEmoji = 0 to ubound(emojiListStr)
      emojiStr = emojiListStr(iEmoji)
      emojiLen = len(emojiStr)
      mutatedLen = emojiLen - 1
      for charPos as integer = 0 to emojiLen - 1
         mutatedStr = cutChar(emojiStr, charPos)
         if mutatedLen < wordLen then
            for strPos as integer = 0 to wordLen - mutatedLen
               partStr = mid(wordStr, strPos + 1, mutatedLen)
               if partStr = mutatedStr then
                  beforeStr = mid(wordStr, 1, strPos)
                  afterStr = mid(wordStr, strPos + mutatedLen + 1)
                  'do not allow T + TRAIN (-T) or T + TRAIN (-T)
                  'do not use F + OK (-K) + R use F + OK (K=R)
                  if charPos = 0 andalso len(beforeStr) = 1 then continue for
                  if charPos = emojiLen - 1 andalso len(afterStr) = 1 then continue for
                  if charPos = 0 andalso right(beforeStr,1) = chr(emojiStr[charPos]) then continue for
                  if emojiLen - 1 andalso left(afterStr,1) = chr(emojiStr[charPos]) then continue for
                  rebusStr = lcase(emojiStr & " (-" & chr(emojiStr[charPos]) & ")")
                  'print indent & tokcat(beforeStr, rebusStr, afterStr)
                  'colorPrint(indent & simplecat(preStr, beforeStr, rebusStr, afterStr, postStr), 14)
                  if len(beforeStr) >= 2 then
                     rebusify(preStr, beforeStr, tokcat(rebusStr, afterStr, postStr), emojiListStr())
                  end if
                  if len(afterStr) >= 2 then
                     rebusify(tokcat(preStr, beforeStr, rebusStr), afterStr, postStr, emojiListStr())
                  end if
                  if len(beforeStr) < 2 and len(afterStr) < 2 then
                     rebusList.add(tokcat(preStr, beforeStr, rebusStr, afterStr, postStr))
                  end if
                  nothing = 0
               end if
            next
         end if
      next
   next
   if nothing = 1 then 'no further solutions found
      'print indent & simplecat(preStr, wordStr, postStr)
      rebusList.add(tokcat(preStr, wordStr, postStr))
   end if
   recursiveDepth -= 1
end sub

dodicat
Posts: 6141
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: Rebus generator

Postby dodicat » Jan 26, 2020 21:58

It's a big job to take on.
Thank you for reconstructing my nomdyploom.
badidea
Posts: 1766
Joined: May 24, 2007 22:10
Location: The Netherlands

Re: Rebus generator

Postby badidea » Jan 26, 2020 23:23

dodicat wrote:It's a big job to take on.
Thank you for reconstructing my nomdyploom.

Yes, a bit bigger then I had in mind. But now, it is only a small step to generate the images.
The only problem is that I did not find an easy way to generate the needed emoji images.
I have a linux tool which which can do it (imagemagick via pango), but I still have to give each image a name manually.
Automation via freebasic using emoji characters doesn't work so well.
Instead, I am now looking up the images on https://emojipedia.org/ and save them with the name I want.
Boring job, but I might as well finish it now. A lot of work for a mostly useless project :-)
badidea
Posts: 1766
Joined: May 24, 2007 22:10
Location: The Netherlands

Re: Rebus generator

Postby badidea » Jan 27, 2020 23:14

I have selected 370 emoji as image (preview), each 120x120 pixels. ~2 hours work.
Next step: Batch convert to reduced size bitmaps, load all and combine with the rebus generator...
badidea
Posts: 1766
Joined: May 24, 2007 22:10
Location: The Netherlands

Re: Rebus generator

Postby badidea » Feb 01, 2020 18:42

Almost done:
Image
paul doe
Posts: 1061
Joined: Jul 25, 2017 17:22
Location: Argentina

Re: Rebus generator

Postby paul doe » Feb 01, 2020 19:46

Wow. Looking gorgeous ;)
badidea
Posts: 1766
Joined: May 24, 2007 22:10
Location: The Netherlands

Re: Rebus generator

Postby badidea » Feb 01, 2020 19:53

paul doe wrote:Wow. Looking gorgeous ;)

Most art by google. They use my data, I use theirs.
Some last things and clean-up to do, then I post the code...
badidea
Posts: 1766
Joined: May 24, 2007 22:10
Location: The Netherlands

Re: Rebus generator

Postby badidea » Feb 01, 2020 23:48

https://github.com/verybadidea/rebus_generator

One of my favorites:
Image

Note: Long words take a lot of time to process.

This one is a bit stupid. Room for improvement:
Image

I should probably remove the 2-character words.

Return to “Projects”

Who is online

Users browsing this forum: No registered users and 2 guests