/* Hiermit erhält man eine Übersicht über seine gesamten Zeichensätze*/
/* © Heiko Schröder / 16.09.96 / Mail: s93324@fh-telekom-leipzig.de */
R='0A'X
say Center("FontLook-Auto V2.51  - 16.09.96 -",74)
say Center("ARexx-Makro für FinalWriter von",74)
say " "
say Center("Heiko Schröder",74)
say Center("Arnoldstr. 1",74)
say Center("04299 Leipzig",74)
say Center("E-Mail: s93324@fh-telekom-leipzig.de",74)
say R||R

a=Show("PORTS")
pos1=Pos("FINALW.",a)
pos2=Pos(" ",a,pos1)
If pos2~=0 then
   a=DelStr(a,pos2)
FW=DelStr(a,1,pos1-1)
address(FW)

SIGNAL ON BREAK_C
Options Results

'ShowMessage 2 1 "FONTLOOK - AUTO v2.51" "für Font-Verzeichnisse..." "(©) Heiko Schröder - 16.09.96" ":-)" "Ok" "(-:"'
'ShowMessage 1 1 "A C H T U N G !" "Das Makro benötigt ein leeres Dokument." "Ihr Dokument wird gelöscht!" "Ja" "Abbruch" ""'
if result=2 then call BREAK_C
Cleardoc Force

'ShowMessage 2 1 "Codes oder Layout" "" "" "Codes" "Layout" ""'
cl=result

/*----------------------------------- REXXREQTOOLS ------------------------*/

Temp="ram:font"
if ~show('L',"rexxreqtools.library") then do
   if ~addlib('rexxreqtools.library',0,-30,0) then do
      'ShowMessage 1 1 "Fehler...." "Benötige RexxReqTools.library" " A B B R U C H ! !" "Okay" "" ""'
      exit
   end
end

dir=rtfilerequest(,,"Verzeichnis auswählen...","»·Start·«","rtfi_flags = freqf_nofiles")
if dir="" then do
   'ShowMessage 1 1 "Kein Verzeichnis ausgewählt!" " A B B R U C H ! !" "" "Okay" "" ""'
   exit
end
dir=d2c(34)||dir||d2c(34)
address command 'list ' dir || ' to=' Temp || ' files lformat "%s%s"'

If OPEN('file',Temp,"R") then
If Seek("file",0,"E")=0 then do
   'ShowMessage 1 1 "Verzeichnis ist leer" " A B B R U C H ! !" "" "Okay" "" ""'
   address "REXX"
   close("file")
   EXIT
end

address "REXX"
close("file")
address command 'sort ' Temp Temp
OPEN('file',Temp, "R")

address(FW)
'ShowMessage 1 1 "Benötigen Sie Locher-Marken?" "" "" "Ja" "Nein" ""'
lm=result
'ShowMessage 1 1 "Wie geht es weiter?" "" "" "Nur Speichern" "Drucken + Speichern" "Nur Drucken"'
wgw=result


/*---------------- Schleife bis alle Fonts ausgegeben worden sind -----------*/

DO WHILE 1
	FontName=ReadLn('file')
	IF EOF('file') THEN do
      address "REXX"
      close('file')
      call Ende
   End

   TextTool
   Font FontName
   a=RC
   If a=0 then do                  /* Kann FW den Font verarbeiten?*/

      Type d2c(32)
      BackSpace
      status FontPath
      FullFontName=result
      pos=LASTPOS('/', FullFontName)
      IF (pos~=0) THEN
         FontName=RIGHT(FullFontName, LENGTH(FullFontName)-pos)
      ELSE DO
         pos=LASTPOS(':', FullFontName)
         IF (pos~=0) THEN
            FontName=Right(FullFontName, LENGTH(FullFontName)-pos)
         ELSE
         EXIT
      END

      GraphicTool
      LinePrefs LineWt .5

      If lm=1 then DrawLine 1 .5 14.85 1 14.85

      If cl=1 then do
         DrawLine 1 2 3.5 20 3.5
         DrawLine 1 2 26 20 26
         TextTool
         Pagesetup Pagetype A4 Orient Tall Top 0 Bottom 2.54 Left 0 Right 0
         SectionSetup Top 2.54 Bottom 2.54 Inside 2 Outside 1

         Do i=0 to 13
            SetTab i*1.3+0.8 Right
         End

         NameFont="FWDocs/Codes-" || FontName
         Justify Center
         Font Softsans
         FontSize 18
         Type FontName||R||R

         Justify Left

         a=0

         DO w=1 to 15

            Font Softsans
            FontSize 8
            DO x=a+33 to a+46
         	   Type d2c(9) || x || d2c(32) || d2c(x)
            END

            Type R

            Font FontName
            FontSize 24
            DO x=a+33 to a+46
            	Type d2c(9)
               Type d2c(x)
            END

            Type R

            a=a+14

         END

         Font Softsans
         FontSize 8
         DO x=a+33 to a+45
         	Type d2c(9) || x || d2c(32) || d2c(x)
         END

         Type R

         Font FontName
         FontSize 24
         DO x=a+33 to a+45
         	Type d2c(9)
            Type d2c(x)
         END
         Type R
         FontSize 12
         Type d2c(9)||R
         Font Softsans

         FontSize 8
         Justify Right
         Type Date(E)

      END

      If cl=2 then do
         DrawLine 1 2 3.4 20 3.4
         TextTool
         Pagesetup Pagetype A4 Orient Tall Pages RightOnly Top 0 Bottom 2.54 Left 0 Right 0
         SectionSetup Top 2.54 Bottom 2.54 Inside 2 Outside 1

         Justify Center
         NameFont="FWDocs/Layout-" || FontName
         Font Softsans
         FontSize 18
         Type FontName||R

         Justify Left
         Font FontName
         FontSize 8
         Type R||"This is 8-point type - not easy to read!"||R

         FontSize 9
         Type "9-Point type is about the smallest readable size."||R

         FontSize 10
         Type "With 10-point type, we have a normal text size."||R

         FontSize 12
         Type "With some Fonts, 12-point type is easier to read."||R

         FontSize 14
         Type "14-point type is good for subheadings."||R

         FontSize 16
         Type "For larger subheadings, try 16-point type."||R

         FontSize 18
         Type "18-point type makes nice small headlines."||R

         FontSize 24
         Type "24-point type is for medium headlines."||R

         FontSize 36
         Type "36-point is for larger ones."||R

         FontSize 48
         Type "48-point almost shouts!"||R

         FontSize 60
         Type "60-point is huge!"||R

         FontSize 12
         Font SoftSans
         Type "NORMAL"||R
         Font FontName
         Type "ABCDEFGHIJKLMNOPQRSTUVWXYZ"||R
         Type "abcdefghijklmnopqrstuvwxyz 1234567890 !@#$%^&*()-+=[]{}/:;,.?"||R
         Type "The quick brown fox jumps over the lazy dog. ÄÖÜäöüß"||R||R

         Font SoftSans
         Type "ERWEITERTER SCHRIFTCODE"||R
         Font FontName
         j=0
         Do i=1 to 4
            Do k=128+j to 159+j
               Type d2c(k)
            End
            Type R
            j=j+32
         End
      End

      If wgw=1 then do      /* Nur Speichern */
         Save NameFont
         Cleardoc
      end

      If wgw=2 then do      /* Speichern+Drucken */
         Save NameFont
         Print
         Cleardoc
      end

      If wgw=3 then do      /* Nur Drucken */
         Print
         Cleardoc force
      end
   end
   else do
      pos=LastPos("/",FontName)
      FontName=Right(FontName,Length(FontName)-pos)
      say d2c(11)||d2c(11)||"FW konnte folgenden Font nicht verarbeiten: "||FontName
      say Copies(" ",50)||d2c(11)
   end
END

Ende:
address(FW)
If cl=1 then 'ShowMessage 2 1 "Die Dokumente sind im FWDocs-Drawer" "zu finden. Erkennbar am «Codes-.....«" "Vielen Dank für die Benutzung." "@-`-" "Bitte" ":-))"'
If cl=2 then 'ShowMessage 2 1 "Die Dokumente sind im FWDocs-Drawer" "zu finden. Erkennbar am «Layout-.....«" "Vielen Dank für die Benutzung." "@-`-" "Bitte" ":-))"'

EXIT

BREAK_C:
   'ShowMessage 1 1 "Makro-Abbruch..." "" "" "Ich weiß..." "" ""'
   address "REXX"
	CLOSE("file")
	SAY 'Makro-Abbruch...'
	EXIT