Introductions and my Packer Program

[Carm3D]

Hello,

I am fairly new with Pure Basic. I've just written a packer program that uses the packer library. I'm sure there are a dozen of these, so what is one more? Mine lets you choose multiple folders and a couple of other options.

Is General Discussion the best place to share programs?

I'm trying to make a videogame with it. So much to learn!

(Now updated to v1.1)

Code: Select all

EnableExplicit

; Initialize variables
Global ConfigFile.s = GetPathPart(ProgramFilename()) + "Multi-Folder_Packer_Config.TXT"
Global SourcePath.s, DestPath.s
Global SourceCount
Global SelectedSource.s, SelectedDest.s, PackFileName.s, PackFilePath.s
Global DetailsFile.s
Global PackID, DetailsID
Global PackerMethod.b, FolderHierarchy.b
Global Folder.s
Global PathName.s
Global Key.s
Global Dim FolderArray.s(1000)

Procedure EndProgram()
	; Update Config.TXT with the latest source and destination paths
	If CreateFile(0, ConfigFile)
		; Write SelectedSource if it’s set, otherwise use SourcePath or "0"
		If SelectedSource <> ""
			WriteStringN(0, SelectedSource)
		ElseIf SourcePath <> ""
			WriteStringN(0, SourcePath)
		Else
			WriteStringN(0, "0")
		EndIf

		; Write SelectedDest if it’s set, otherwise use DestPath or "0"
		If SelectedDest <> ""
			WriteStringN(0, SelectedDest)
		ElseIf DestPath <> ""
			WriteStringN(0, DestPath)
		Else
			WriteStringN(0, "0")
		EndIf
		CloseFile(0)
	Else
		ConsoleColor(12, 0)
		PrintN("Warning: Could not update Multi-Folder_Packer_Config.TXT.")
	EndIf
	ConsoleColor(8, 0)
	PrintN("")
	PrintN("Press RETURN to exit...")
	Input()
	End
EndProcedure

Procedure YesNo()
	Repeat
		Key = Inkey(); wait for key press
		If LCase(Key) = "y" Or LCase(Key) = "n"
			Break
		EndIf
		Delay(7)
	ForEver

	Select LCase(Key)
		Case "y"
			ConsoleColor(11, 0)
			PrintN("Yes")
		Case "n"
			ConsoleColor(11, 0)
			PrintN("No")
	EndSelect
EndProcedure

Procedure Menu12()
	Repeat
		Key = Inkey(); wait for key press
		If LCase(Key) = "1" Or LCase(Key) = "2"
			Break
		EndIf
		Delay(7)
	ForEver
EndProcedure

Procedure GetFolderName()
	; Remove trailing backslash if it exists
	If Right(PathName, 1) = "\"
		PathName = Left(PathName, Len(PathName) - 1)
	EndIf

	; Extract the last folder name
	Folder = GetFilePart(PathName)
EndProcedure

; Open the console for user interaction
OpenConsole()

; Check if Config.TXT exists, create if not
If FileSize(ConfigFile) = -1
	If CreateFile(0, ConfigFile)
		WriteStringN(0, "0")
		WriteStringN(0, "0")
		CloseFile(0)
	Else
		ConsoleColor(12, 0)
		PrintN("Error: Could not create Multi-Folder_Packer_Config.TXT.")
		EndProgram()
	EndIf
EndIf

; Read Config.TXT
If ReadFile(0, configFile)
	SourcePath = ReadString(0)
	DestPath = ReadString(0)
	CloseFile(0)
Else
	ConsoleColor(12, 0)
	PrintN("Error: Could not read Multi-Folder_Packer_Config.TXT.")
	EndProgram()
EndIf

; Validate source and destination paths
If SourcePath <> "0" And FileSize(SourcePath) <> -2
	SourcePath = "0"
EndIf
If DestPath <> "0" And FileSize(DestPath) <> -2
	DestPath = "0"
EndIf

SourceCount = -1

Define LoopQuery.s
Define InitialSource.s = ""
If SourcePath <> "0" ; Set initial value from Multi-Folder_Packer_Config.TXT once
	InitialSource = SourcePath
EndIf
ConsoleColor(14, 0)
PrintN("Multi-Folder Packer v1.1 by Carm3D")
PrintN("")
ConsoleColor(8, 0)
PrintN("This little program will let you select multiple")
PrintN("folders (1000 limit), choose a compression option,")
PrintN("and pack the Data into a single file for your Pure")
PrintN("Basic projects.  Enjoy!")
PrintN("")

Repeat
	; Prompt user to choose source folder
	ConsoleColor(14, 0)
	PrintN("")
	If SourceCount = -1
		PrintN("Add folder to pack?(y/n)")
	Else
		PrintN("Add another folder to pack?(y/n)")
	EndIf

	YesNo()

	If LCase(Key) = "n"
		Break
	EndIf

	SelectedSource = PathRequester("Select Source Folder", InitialSource)
	If SelectedSource = ""
		ConsoleColor(12, 0)
		PrintN("No folder selected.")
	Else
		SourceCount = SourceCount + 1
		FolderArray(SourceCount) = SelectedSource
		PathName = SelectedSource
		GetFolderName()
		ConsoleColor(11, 0)
		PrintN(Folder + " added.")
		InitialSource = SelectedSource
	EndIf
ForEver

If SourceCount = -1
	ConsoleColor(12, 0)
	PrintN("No folders selected. Exiting.")
	EndProgram()
EndIf


; Choose destination folder
Define InitialDest.s = ""
If DestPath <> "0"
	InitialDest.s = DestPath
EndIf

Repeat
	Define TryAgain.s
	ConsoleColor(14, 0)
	PrintN("")
	PrintN("Select the destination folder for the packed file:")
	SelectedDest = PathRequester("Select Destination Folder", InitialDest)

	If SelectedDest = ""
		ConsoleColor(12, 0)
		PrintN("No destination folder selected. Try again?(y/n)")

	YesNo()

		If LCase(Key) = "n"
			EndProgram()
		EndIf
	Else
		ConsoleColor(11, 0)
		PrintN(SelectedDest)
		PrintN("chosen for Destination folder.")
		Break
	EndIf
ForEver

; Choose Packed File Name
Repeat
	Define TryAgain.s
	ConsoleColor(14, 0)
	PrintN("")
	PrintN("Enter the name for the packed file (e.g., archive.pack):")
	PackFileName = Input()
	If PackFileName = ""
		ConsoleColor(12, 0)
		PrintN("No file name entered.  Try again?(y/n)")

		YesNo()

		If LCase(Key) = "n"
			EndProgram()
		EndIf
	Else
		Break
	EndIf
ForEver

; Construct full path for packed file
PackFilePath = SelectedDest + PackFileName

	ConsoleColor(14, 0)
	PrintN("")
	PrintN("Choose Packer Method:")
	ConsoleColor(8, 0)
	PrintN("1 = Zip Packer")
	PrintN("2 = BriefLZPacker (can NOT preserve folder heirarchy!)")
	Menu12()
	Select LCase(Key)
	Case "1"
		ConsoleColor(11, 0)
		PrintN("Zip Packer")
		PackerMethod = 1
	Case "2"
		ConsoleColor(11, 0)
		PrintN("BriefLZPacker")
		PackerMethod = 0
	EndSelect

If PackerMethod
	UseZipPacker()
Else
	UseBriefLZPacker()
EndIf

Define TryAgain.s
Define FolderChoice.s
ConsoleColor(14, 0)
PrintN("")
PrintN("Choose to retain original folder hierchy:")
ConsoleColor(8, 0)
PrintN("1 = Pack files in folders, keeping original hierchy")
PrintN("2 = Pack files together in a single root location")
Menu12()
	Select LCase(Key)
Case "1"
	ConsoleColor(11, 0)
	PrintN("Folder Hierarchy")
Case "2"
	ConsoleColor(11, 0)
	PrintN("No Hierarchy")
EndSelect

	If Key = "1"
		FolderHierarchy = 1
	Else
		FolderHierarchy = 0
	EndIf


; Create packed file
PackID = CreatePack(#PB_Any, PackFilePath)
If PackID = 0
	ConsoleColor(12, 0)
	PrintN("Failed to create packed file.")
	EndProgram()
EndIf

; Prepare details file in destination folder
DetailsFile = selectedDest + "PackDetails.txt"
If CreateFile(1, DetailsFile)
	DetailsID = 1
Else
	ConsoleColor(12, 0)
	PrintN("Failed to create details file.")
	ClosePack(PackID)
	EndProgram()
EndIf

; Add files from all folders in FolderArray() to pack and record details
Define offset.q = 0
Define i.l
For i = 0 To SourceCount - 1
	PathName = FolderArray(i)
	GetFolderName()

	If FolderHierarchy
		AddPackDirectory(PackID, Folder)  ; Add folder structure if retaining hierarchy
	EndIf
	If ExamineDirectory(0, FolderArray(i), "*.*")
		While NextDirectoryEntry(0)
			If DirectoryEntryType(0) = #PB_DirectoryEntry_File
				Define FileName.s = DirectoryEntryName(0)
				Define FilePath.s = FolderArray(i) + FileName
				Define FileSize.q = FileSize(FilePath)
				If FolderHierarchy
					AddPackFile(PackID, FilePath, Folder + "/" + FileName)  ; e.g., "Images/file1.txt"
					WriteStringN(DetailsID, "File: " + Folder + "/" + FileName)
				Else
					AddPackFile(PackID, FilePath, FileName)  ; Flat structure
					WriteStringN(DetailsID, "File: " + FileName)
				EndIf
				WriteStringN(DetailsID, "Size: " + Str(FileSize))
				WriteStringN(DetailsID, "Offset: " + Str(offset))
				WriteStringN(DetailsID, "")
				offset + FileSize
			EndIf
		Wend
		FinishDirectory(0)
	Else
		ConsoleColor(12, 0)
		PrintN("Could not examine directory: " + FolderArray(i))
	EndIf
Next

ClosePack(PackID)
CloseFile(DetailsID)
PrintN("")
ConsoleColor(8, 0)
PrintN("Packing complete. Details saved to")
ConsoleColor(14, 0)
PrintN(DetailsFile)
EndProgram()

// Moved from "General Discussion" to "Applications - Feedback and Discussion" (Kiffi)

[Quin]

Hi Carm3D,
Nice seeing you here after talking on the Discord
The best place for sharing programs is in the Applications Feedback forum, but general works as well
Thanks for sharing!

[benubi]

Congrats to your first program; now the pro's and con's

Pros: I like the multi color console output

Cons: Either use console or GUI, mixed mode (which I also often do) is not usable in production; same goes with OpenScreen() + MessageRequester() things in full screen mode.


Glitch/Bug: When I don't add a directory (click on cancel in the requester), and then the program asks me again if I want to add a path, but when I select N it does as if I had confirmed.

You can also use Inkey() like in this example to make your app more "reactive" :

Code: Select all

Select Lcase(Inkey())
   Case "y"
       PrintN("Yes")
   Case "n"
       PrintN("Nope")
EndSelect

Delay(1) ; <- may be useful 

Inkey() might be useful when your code does something while waiting for user input; The Input() command blocks the execution and waits until the user has entered a line/confirmed with return, and this may sometimes not be wanted.

[Carm3D]

Cons: Either use console or GUI, mixed mode (which I also often do) is not usable in production; same goes with OpenScreen() + MessageRequester() things in full screen mode.

It went full-screen for you??

Glitch/Bug: When I don't add a directory (click on cancel in the requester), and then the program asks me again if I want to add a path, but when I select N it does as if I had confirmed.

Oh interesting.. I'll look into that, thanks.

You can also use Inkey() like in this example to make your app more "reactive" :

Having it repeat the user's input. Cool tip, thanks.

[Carm3D]

Congrats to your first program; now the pro's and con's

Okay I just updated the code to v1.1. I really like the InKey() feature and having it echo your choices. Also I fixed the bug you spotted and another I spotted.

[benubi]

Well, it's getting better. For now, as it is typical for the first steps, you write GOTO style programs. As you progress you will create more procedures/functions and start factorizing your code in this way, make parts of it reusable.

Here is an idea how such helper function could look for console applications; this is an incomplete, or buggy code, but it may give you inspiration.

Here's something I just wrote; it allows you flexibility in language output and inkey input. The only thing you have to respect is the order of the keys, meaning yes/no/cancel options order should be the same in every "Allowed$" language string, just as the order of the language strings is constant inside the array, too.

Having reusable parts of code like procedures will speed up your creative process and make the code easier maintainable. Here I use an array for the language strings, but you could also use a Map with key-value pairs extracted from a text file (or XML/JSON etc) or an other method once you are there and need it.

Code: Select all

; little console askers/helpers
Define EXIT ; global application exit variable, helps escaping loops

Procedure AskUserInkey(Prompt$, Allowed$)
  Shared EXIT 
  Print(prompt$)
  Protected result, k$
  Repeat 
    k$=Inkey()
    If k$=Chr(27) ; escape key (asc 27)
      EXIT=#True  ; Application exit
    ElseIf k$<>#Empty$
      result = FindString(LCase(Allowed$),LCase(k$)+"=")
    EndIf 
   Delay(1)
  Until EXIT Or result 
  If result 
    PrintN(Trim(StringField(Mid(Allowed$,result+2),1,"|")))
    result=1+CountString(Left(allowed$,result),"=")
  EndIf 
  ProcedureReturn result 
EndProcedure

Procedure AskUserNum(Prompt$, max)
  Shared EXIT 
  Protected result 
  Print(Prompt$)
  Repeat 
    k$=Inkey()
    If k$=Chr(27) ; escape key
      EXIT=#True  ; Application exit
    Else 
      Select Asc(k$)
        Case '0' To '9' ; result from ASCII offset difference
          result=Asc(k$)-'0'
          If result<=max 
            Break 
          EndIf 
        Default
          ;-- ignore other keys
      EndSelect
    EndIf 
   Delay(1)
  Until EXIT
  PrintN(Str(result)) 
  ProcedureReturn result 
  
EndProcedure


Global Dim Lang$(10,3)

Procedure LoadLang()
  Protected j,i,ln$
  Restore lang_en
  For j=0 To 2
    For i=0 To 9
      Read.s ln$
      Lang$(i,j) = ln$
    Next 
  Next 
DataSection
  lang_en:
  Data.s "English"
  Data.s "Are you civilian or military? (c/m): "
  Data.s "C=Civilian|M=Military"
  Data.s "Did you take your screen break, yet? (y/n): "
  Data.s "y=Yes|n=No"
  Data.s "y=Sir, yes, Sir!|n=Sir, no, Sir!"
  Data.s "Then it's time for a screen break."
  Data.s "There's still time for an extended break."
  Data.s "Good bye!"
  Data.s "Execution finished (RETURN)"
  lang_fr:
  Data.s "Français"
  Data.s "Êtes-vous civil ou militaire? (c/m): "
  Data.s "C=Civil|M=Militaire"
  Data.s "Avez-vous déjà pris votre pause-écran? (o/n): "
  Data.s "O=Oui|N=Non"
  Data.s "O=Oui, mon capitaine!|N=Non, mon capitaine!"
  Data.s "Alors il est temps pour une pause-écran." ; The devil speaketh in rhymes
  Data.s "Alors il y'a encore assez de temps pour une pause prolongée."  ;-)
  Data.s "Au revoir!" 
  Data.s "Éxecution terminée (RETOUR)"
  lang_de:
  Data.s "Deutsch"
  Data.s "Sind Sie Zivilist oder Militär? (z/m): "
  Data.s "Z=Zivilist|M=Militär"
  Data.s "Haben Sie schon Ihre Bildschirmpause gemacht? (j/n): "
  Data.s "J=Ja|N=Nein"
  Data.s "J=Jawohl, Herr Hauptmann!|N=Nein, Herr Hauptmann!"
  Data.s "Dann ist es jetzt Zeit für eine Bildschirmpause."
  Data.s "Dann ist noch genug Zeit für eine verlängerte Pause."
  Data.s "Auf Wiedersehen!"
  Data.s "Programmende (EINGABETASTE)"
EndDataSection
EndProcedure

Procedure Main()
OpenConsole()
LoadLang()
; Select language
Protected i
For i=0 To 2
  PrintN(Str(i)+": "+Lang$(0,i))
Next 
PrintN("")

; ask things
Protected lang = AskUserNum("->",2)
Protected type = AskUserInKey(Lang$(1,lang), Lang$(2,lang))
Protected pause= AskUserInKey(Lang$(3,lang), lang$(3+type,lang))
; tell what to do next
If pause=2
  PrintN(lang$(6,lang))
Else 
  PrintN(lang$(7,lang))
EndIf
; say good bye
PrintN(lang$(8, lang))
PrintN("")
; display program end message
PrintN(lang$(9,lang))
Input()
CloseConsole()
End 
EndProcedure

Main()

[Carm3D]

Well, it's getting better. For now, as it is typical for the first steps, you write GOTO style programs.

I'm not sure what you are trying to put a light on here.. Procedures? I did use procedures. Multi-language support?

[benubi]

Sorry for causing confusion. GOTO style / straight-forward, nothing to be worried about. After OpenConsole() the program is straight-forward (looks like 80% of it's size). This is no problem for demo code and proof-of-concept, but when you have a bigger project these "rigid" parts may become obstructive for adaptation. In practice the long code will be divided into smaller portions (procedures), and the main body would be put into a Main() procedure using those procedures. That would be the "natural" steps how the program should evolve over time and length; but there are always exceptions that confirm the rule, program-types that will need the GOTO command to work properly or short codes that don't loop and need no procedures etc.

It's just about continuing factorizing the code / style; as you mentioned you already started with it, you will get used to "optimize" by hand in that manner and your style will evolve over time. So no worries, your style isn't bad either, it's just the natural way how it "evolves" - the first steps in Basic languages are nearly always Goto/Gosub style programs, with Print hello world etc. since the first Basic dialects were invented (which is the origin of the prejudice Basic=Goto programming, too).

https://en.wikipedia.org/wiki/Goto

[Carm3D]

After OpenConsole() the program is straight-forward (looks like 80% of it's size).

I felt that that was all that was needed for such a small utility. I made it because I wanted to pack files for a larger project I am working on:

https://www.purebasic.fr/english/viewtopic.php?t=86392

I started programming since before I got my Atari 800. I know all about GOTO.