/* Make Font-List for Wordworth 5 and 6        */
    /*  $VER: Version 1.2e 26.6.97   Heiko Kuschel */
   /*   <hk0006@wuerzburg.baynet.de>              */
  /*    Freeware (C) 1997 Heiko Kuschel          */



 /* --------------------------------*/
/*  Change Fontsize and Text here: */

FontSize="15pt"
Text1="ABCDEFG HIJKLMNOP QRSTUVW XYZÄÖÜ"
Text2="abcdefg hijklmnop qrstuvw xyzäöüß"
Text3="12345 67890 !§$%& /()=?"

/* -----------------------------*/




signal on error
DO Num = 1 to 20
        WwPort = "WORDWORTH." || Num
        IF SHOW(PORTS, WwPort) THEN DO
                Address Value WwPort
                leave Num
        end
end
if num=21 then do
    echo "Wordworth not found! Program ends."
    exit
    end
OPTIONS RESULTS

NEW
PORTNAME=RESULT
ADDRESS VALUE PORTNAME
OPEN Filename "Env:Wordworth/WWFonts"
Gettext
Pathname=Result
selectall
delete
Do Until NameOfFile~=""
  REQUESTFILE title "Select name for Fontlist." path Pathname"//" File Fontlist
  NameOfFile = Result
end
Ok=open(Fontsfile,Pathname"/UFST/FontList","R")   /* Count lines. not possible with WW5.*/
Lines=-1
do until eof(Fontsfile)
Lines=Lines+1
b=readln(Fontsfile)
end


if Lines > 80 then do
    Dot="."
    do until ((Parts<(Lines/5))&(Parts>=1))
       wizardreq title "How many Parts?" label "You have installed "||Lines||" fonts." label "It may be that Wordworth makes problems if" label "you want it to show them all at once." label "Split the Fontlist in how many parts:" label "Recommended: at least "||((Lines%80)+1) textbox 1 "_Parts:" Button 1 "_Ok" Button "-1" "_Cancel"
       if result = "-1" then do
            exit
       end
       else do
         nop
       end
       Wizard_Gettextbox (1)
       Parts=Result
       if (Parts>=(Lines/5))|(Parts<1) then do
         Wizardreq Title "Problem" label "Your answer makes no sense." label "You have installed "||Lines||" fonts." Button 1 "_OK" Button "-1" "_Cancel"
         if result = "-1" then do
           Exit
          end
       end
    end
    if Parts>1 then do
      wizardreq Title "Attention!" label "The parts will be named" label NameOfFile||".1 to" label NameOfFile||"."||Parts button 1 "_OK" button 2 "_Select new name" button "-1" "_Cancel"
      PressedButton=Result
      select
      When PressedButton=2 then do Until NameOfFile~=""
          REQUESTFILE title "Select name for fontlist." path Pathname"//" File Fontlist
          NameOfFile = Result
      end
      When PressedButton="-1" then do
        exit
      end
      otherwise do
        nop
      end
      end
    end
end
else do
  Parts=1
end
Remains=0
open Filename Pathname"/UFST/FontList" force
saveas name NameOfFile   /*Change name of File, so that Env:Wordworth/Fontlist is not changed by mistake.*/
selectall
sortascending
position eof
newparagraph
POSITION SOF
FINDCHANGE ALL FIND ",\*,?¶" CHANGE "¶¶"
POSITION SOF
saveas name Dateiname
do Part = 1 to Parts
open filename NameOfFile
position sof
if Part > 1 then do
  gotoline ((Lines%Parts)+(Part-2)*(Lines%Parts))*2-1
  ctrldown
  cursor Right
  ctrldown
  shiftdown
  cursor up
  ctrlup
  shiftup
  delete
  delete
  end
if Part < Parts then do
  gotoline (Lines%Parts)*2-1
  ctrldown
  cursor left
  ctrldown
  shiftdown
  cursor down
  ctrlup
  shiftup
  delete
  end
if Part=Parts Then Remains=(Lines//Parts)
position sof
DO Counter=1 TO ((Lines%Parts)+Remains)
  CTRLDOWN
  CURSOR LEFT
  CTRLDOWN
  SHIFTDOWN
  CURSOR RIGHT
  GETTEXT
  FONTNAME=RESULT
  CTRLUP
  SHIFTUP
  CURSOR DOWN
  FONT Name FONTNAME Size FontSize
  TEXT Text1
  NEWPARAGRAPH
  TEXT Text2
  NEWPARAGRAPH
  TEXT Text3
  CURSOR DOWN
END
if Parts=1 then do
    Part=""
    Dot=""
    address command delete NameOfFile
    end
saveas name NameOfFile||Dot||Part
end
exit

error:
echo "Sorry, an error has occured."
echo "Line " Sigl", Number " RC
echo errortext(RC)
exit
return