Author Topic: Menu me this....  (Read 4483 times)

Offline John

  • Forum Support / SB Dev
  • Posts: 2741
    • ScriptBasic Open Source Project
Re: Menu me this....
« Reply #15 on: October 22, 2018, 07:14:36 PM »
Here is my last version with your improvements running on Windows 7 32 bit OS. Something strange going on with returning lower case filenames The file explorer, DIR and SB.display different results. (another reason why I dislike Windows)

Code: Script BASIC
  1. ' AIR - Select user for backup
  2.  
  3. FUNCTION SelectFolder(Title, Folder)
  4.   LOCAL fn, Exclude, Border, Search_Options, file_list, fName, users, idx, uid
  5.   fn = FREEFILE()
  6.   Exclude = "Default|Public"
  7.   Border = STRING(LEN(Title), "-")
  8.   file_list = ""
  9.   OPEN DIRECTORY Folder PATTERN "" OPTION SbCollectDirectories AS #fn
  10.   RESET DIRECTORY #fn
  11.   fName = NEXTFILE(fn)
  12.   WHILE fName <> undef
  13.     IF NOT INSTR(Exclude, fName) = undef THEN file_list &= fName & "\n"
  14.     fName = NEXTFILE(fn)
  15.   WEND
  16.   CLOSE DIRECTORY #fn
  17.   SPLITA file_list BY "\n" TO users
  18.   Retry:
  19.   PRINT Title,"\n",Border,"\n"
  20.   FOR idx = 0 TO UBOUND(users)
  21.     PRINT idx + 1,") ",users[idx],"\n"
  22.   NEXT
  23.   PRINT Border,"\n","Select User: "
  24.   LINE INPUT uid
  25.   uid = CHOMP(uid)
  26.   IF uid - 1 > UBOUND(users) OR users[uid - 1] = undef THEN
  27.     PRINT ">> Invalid Selection <<", "\n\n"
  28.     GOTO Retry
  29.   END IF
  30.   SelectFolder = users[uid -1]
  31. END FUNCTION
  32. PRINT "You Selected: ", SelectFolder("Armando's Test Menu", "/Users"), "\n"
  33.  

« Last Edit: October 22, 2018, 10:24:18 PM by John »

Offline AIR

  • BASIC Developer
  • Posts: 684
Re: Menu me this....
« Reply #16 on: October 22, 2018, 08:13:19 PM »
Ruby Version

In case Tomaaz is lurking.... 8)

Code: Ruby
  1. #!/usr/bin/env ruby
  2.  
  3. def SelectFolder(title,path)
  4.     $menu = {}
  5.  
  6.     $Loop = 1
  7.     $Exclude = ['Shared','Guest','Public']
  8.     $Border = "-"*title.length
  9.  
  10.     while $Loop == 1
  11.         puts "\e[H\e[2J"
  12.         puts title
  13.         puts $Border
  14.         $Count = 1
  15.         for fPath in Dir.glob(path + '/*')
  16.             $fNAME = File.basename("#{fPath}")
  17.  
  18.             if not $Exclude.include? "#{$fNAME}"
  19.                 puts $Count.to_s + ") " + "#{$fNAME}"
  20.                 $menu[$Count] = "#{$fNAME}"
  21.                 $Count+=1
  22.             end
  23.         end
  24.         puts $Border
  25.         print "\nSelect User: "
  26.         choice = gets
  27.         $selected = $menu[choice.to_i]
  28.         if $selected
  29.             $Loop = 0
  30.         else
  31.             puts ">> Invalid Selection <<"
  32.             sleep 1
  33.             next
  34.         end
  35.  
  36.     end
  37.     return $selected
  38. end
  39.  
  40. $selected = SelectFolder("Armando's Test Menu","/Users")
  41.  
  42. puts "\nYou Selected: #{$selected}"

I really don't like the Ruby syntax, but to each his/her own....

AIR.

Offline John

  • Forum Support / SB Dev
  • Posts: 2741
    • ScriptBasic Open Source Project
Re: Menu me this....
« Reply #17 on: October 22, 2018, 11:23:32 PM »
I added an ANSI escape sequence to the Linux version to clear the screen if an invaild selection is made before retrying. It doesn't seem to work on Windows, surprised?

Code: Script BASIC
  1. '' AIR - Select user for backup
  2.  
  3. FUNCTION SelectFolder(Title, Folder)
  4.   LOCAL fn, Exclude, Border, Search_Options, file_list, fName, users, idx, uid
  5.   fn = FREEFILE()
  6.   Exclude = "Guest|Shared"
  7.   Border = STRING(LEN(Title), "-")
  8.   file_list = ""
  9.   OPEN DIRECTORY Folder PATTERN "" OPTION SbCollectDirectories AS #fn
  10.   RESET DIRECTORY #fn
  11.   fName = NEXTFILE(fn)
  12.   WHILE fName <> undef
  13.     IF NOT INSTR(Exclude, fName) = undef THEN file_list &= fName & "\n"
  14.     fName = NEXTFILE(fn)
  15.   WEND
  16.   CLOSE DIRECTORY #fn
  17.   Retry:
  18.   SPLITA file_list BY "\n" TO users
  19.   PRINT Title,"\n",Border,"\n"
  20.   FOR idx = 0 TO UBOUND(users)
  21.     PRINT idx + 1,") ",users[idx],"\n"
  22.   NEXT
  23.   PRINT Border,"\n","Select User: "
  24.   LINE INPUT uid
  25.   uid = CHOMP(uid)
  26.   IF users[uid - 1] = undef THEN
  27.     PRINT "\033[H\033[2J"
  28.     UNDEF users
  29.     GOTO Retry
  30.   END IF
  31.   SelectFolder = users[uid -1]
  32. END FUNCTION
  33. Selected = SelectFolder("Armando's Test Menu", "/home")
  34. PRINT "You Selected: ", Selected, "\n"
  35.  

« Last Edit: October 22, 2018, 11:59:37 PM by John »

Offline AIR

  • BASIC Developer
  • Posts: 684
Re: Menu me this....
« Reply #18 on: October 23, 2018, 04:47:55 PM »
I added an ANSI escape sequence to the Linux version to clear the screen if an invaild selection is made before retrying. It doesn't seem to work on Windows, surprised?

In Windows 10, there is supposed to be a registry flag you can set to enable the built-in support for ANSI sequences.  Or you can try loading up Ansi.sys (16 bit though!!) or one of the later Ansi.sys enhancements.

Or you can just exec the "cls" command...

John, does SB support conditional execution based on OS?  Like an #IFDEF in C?

AIR.

Offline John

  • Forum Support / SB Dev
  • Posts: 2741
    • ScriptBasic Open Source Project
Re: Menu me this....
« Reply #19 on: October 23, 2018, 04:55:18 PM »
Quote
John, does SB support conditional execution based on OS?  Like an #IFDEF in C?

The SB OPTION feature is a good example of conditional code execution. The SB ENVIRON() function returns a wealth of information about what you're running under. The conditional code execution could be based on that in BASIC.

I still have one more round for your challenge which is to give it an ANSI dress. (color / line graphics)

Any idea how you want to handle the Windows version of this and the issues I describe in a previous post?
« Last Edit: October 25, 2018, 03:07:15 PM by John »

Offline AIR

  • BASIC Developer
  • Posts: 684
Re: Menu me this....
« Reply #20 on: October 23, 2018, 06:09:58 PM »
SB apparently doesn't honor the Hidden attribute for files/folders, so you'll have to add those "extra" directories to the filter list.


Offline John

  • Forum Support / SB Dev
  • Posts: 2741
    • ScriptBasic Open Source Project
Re: Menu me this....
« Reply #21 on: October 23, 2018, 06:22:37 PM »
Since SB Windows is returning file names in lowrer case, does it matter for the choice value returned?
« Last Edit: October 23, 2018, 06:26:33 PM by John »

Offline AIR

  • BASIC Developer
  • Posts: 684
Re: Menu me this....
« Reply #22 on: October 23, 2018, 07:04:13 PM »
Not directly, since that is how SB is returning the directory name itself when in Windows. But it will affect the exclusions unless they are also all lowercase.

The conversion to lowercase is done in the file "filesys.c", in the "file_readdir" function (which I believe NEXTFILE actually calls).

Within that function, this line:

Code: C
  1. for( ; *s ; s++ )if( isupper(*s) )*s = tolower(*s);

Changes the returned filename to all lowercase.  This is only enabled when SB is compiled for Windows.

AIR.

Offline John

  • Forum Support / SB Dev
  • Posts: 2741
    • ScriptBasic Open Source Project
Re: Menu me this....
« Reply #23 on: October 23, 2018, 07:12:49 PM »
That's just the tip of the iceberg. What about unicode file names?

Offline AIR

  • BASIC Developer
  • Posts: 684
Re: Menu me this....
« Reply #24 on: October 23, 2018, 07:35:17 PM »
If SB doesn't support unicode presently, you would have to alter at the very least all file-related functions so that they would use the "W" variant of the native C functions instead of the "A" (Ansi) variant which if I remember from my Windows days is the default. 

You would also probably need to alter some of the string functions and how the buffers themselves are allocated and removed.

Not a task for the faint of heart.  That's my ultra high level view, anyway.

But that conversation really doesn't belong in this thread.

Offline John

  • Forum Support / SB Dev
  • Posts: 2741
    • ScriptBasic Open Source Project
Re: Menu me this....
« Reply #25 on: October 23, 2018, 07:58:24 PM »
Oxygen Basic is currently going through that transistion.

This might be a way SB can deal with unicode.

https://www.gnu.org/software/libunistring/manual/
« Last Edit: October 23, 2018, 08:03:30 PM by John »

Offline AIR

  • BASIC Developer
  • Posts: 684
Re: Menu me this....
« Reply #26 on: October 24, 2018, 08:44:59 AM »
FreePascal Version (Tested on macOS and Windows 10)

Code: Pascal
  1. Program MenuDemo;
  2. {$mode objfpc}{$H+}
  3.  
  4.  
  5. Uses SysUtils, StrUtils, Crt;
  6.  
  7. Function SelectFolder(Title,Path:String): String;
  8.     Var
  9.         Info : TSearchRec;
  10.         Count, Selection : Longint;
  11.         Menu  : array[0..14] of String;
  12.         Choice, Border: String;
  13.         Loop : Boolean = True;
  14.         Exclude: array[0..2] of String = ('Shared','Public','Guest');
  15.  
  16.     Begin
  17.         Repeat
  18.             ClrScr;
  19.             Border := DupeString('-',Length(Title));
  20.             Writeln(Title);
  21.             Writeln(Border);
  22.             Count:=0;
  23.             If FindFirst (Path + '/*',faDirectory,Info)=0 then begin
  24.                 Repeat
  25.                     With Info do begin
  26.                         If (Attr and faDirectory) = faDirectory then begin
  27.                             If ( LeftStr(Name,1) <> '.' ) AND ( AnsiIndexStr(Name,Exclude) = -1 ) then begin
  28.                                 Writeln (Count+1,') ',Name);
  29.                                 Menu[Count] := Name;
  30.                                 Inc(Count);
  31.                             end;
  32.                         end;
  33.                     end;
  34.                 Until FindNext(info) <> 0;
  35.             end;
  36.  
  37.             FindClose(Info);
  38.  
  39.             Writeln(Border);
  40.            
  41.             Write ('Select User: ');
  42.             ReadLn(Choice);
  43.  
  44.             try
  45.                 Selection := StrToInt(Choice);
  46.                 If (Selection < 1) Or (Selection > Count) Then
  47.                     raise Exception.Create('Out of Range');
  48.                 Loop := False;
  49.             except
  50.                 begin
  51.                     Writeln('>> Invalid Selection <<');
  52.                     Sleep (1000);
  53.                     Continue;
  54.                 end;
  55.             end;
  56.  
  57.         Until Loop = False;
  58.  
  59.         Result := menu[Selection-1];
  60. End;
  61.  
  62.  
  63. {** PROGRAM START **}
  64.  
  65. Var
  66.     Selected: String;
  67.  
  68. Begin
  69.     Selected := SelectFolder('Armando''s Test Menu', '/Users');
  70.  
  71.     Writeln(sLineBreak,'You Selected: ', Selected, sLineBreak);
  72. End.
  73.  


I haven't used Pascal in a LOOOOOONG time.  The last time was when I created an IDE for Hotbasic using Delphi...about 10 years ago.  It was fun gong back in time, so to speak...

AIR.

Offline John

  • Forum Support / SB Dev
  • Posts: 2741
    • ScriptBasic Open Source Project
Re: Menu me this....
« Reply #27 on: October 24, 2018, 09:05:13 AM »
I wish that wasted effort with Hot Basic could have been used to advance Script BASIC instead.  :-\
« Last Edit: October 24, 2018, 09:46:32 AM by John »

Offline AIR

  • BASIC Developer
  • Posts: 684
Re: Menu me this....
« Reply #28 on: October 24, 2018, 09:55:37 AM »
I learned a LOT from Jim, both ASM _AND_ C as well as coding in general.  As much as he's always hated on C, he's very good at it.  Go figure.

I also learned a LOT from that community, which was always willing to answer questions and explain how they were able to enhance the language with their own crafted modules.

So not a wasted effort from my point of view, because if nothing else I was taught how NOT to wait for "someone else to do it".....

AIR.


Offline John

  • Forum Support / SB Dev
  • Posts: 2741
    • ScriptBasic Open Source Project
Re: Menu me this....
« Reply #29 on: October 24, 2018, 10:07:38 AM »
Experiance doesn't come cheap.