/* $VER: MakeFontMaps.rexx 1.0 (28.12.97) by NDY's */

OPTIONS RESULTS

/* already running? */
portname="MakeFontMapsPort"
IF Show("P",portname) THEN
  DO
    ADDRESS VALUE portname
    Kill /* send any command to terminate */
    EXIT
  END

/* command line options */
PARSE ARG dir
cmd=1
rqtools=0
IF dir="?" THEN
  DO
    CALL quit("rx MakeFontMaps.rexx [fontdirectory]",0)
  END
ELSE
  IF dir~="" THEN
    DO
      IF ~xexists(dir) THEN CALL quit("Directory not found:" dir,10)
    END
  ELSE
    cmd=0

/* add libraries */
lib="rexxsupport.library"
IF ~Show("l",lib) THEN
  IF ~AddLib(lib,0,-30,0) THEN CALL quit(lib||" not found!",14)
IF cmd=0 THEN
  DO
    lib="rexxreqtools.library"
    IF ~Show("l",lib) THEN
      IF ~AddLib(lib,0,-30,0) THEN CALL quit(lib||" not found!",14)
    rqtools=1
  END

/* create port */
IF ~cmd THEN
  DO
    port=OpenPort(portname)
    IF ~port THEN CALL quit("Couldn't open port",10)
  END

/* check Final Writer */
IF ~Show("P","FINALW.1") THEN CALL quit("Please run Final Writer first!",10)
ADDRESS "FINALW.1"
SetMeasure "MICROPOINTS"

/* create directory if not existing */
path="FinalWrapper:"
IF ~xexists(path) THEN CALL quit("Assign FinalWrapper: is needed,|please install FinalWrapper first",10)
path=path||"Files"
IF ~xexists(path) THEN ADDRESS COMMAND MakeDir path
IF RC~=0 THEN CALL quit("Error while creating directory:|"||path,10)
path=path||"/FontMaps"
IF ~xexists(path) THEN ADDRESS COMMAND MakeDir path
IF RC~=0 THEN CALL quit("Error while creating directory:|"||path,10)
path=path||"/"

/* select directory */
IF dir="" THEN /* no command line given */
  DO
    /* query font directory */
    dir=RTFileRequest(dir,"","Select a font-directory:","OK","RT_SCREENTOFRONT=TRUE RTFI_FLAGS=FREQF_NOFILES")
    IF dir="" THEN EXIT 0
    IF ~xexists(dir) THEN CALL quit("Directory not found:" dir,10)
  END
IF Right(dir,1)~="/" & Right(dir,1)~=":" THEN dir=dir||"/"

/* create font maps */
CALL display("Processing directory:" dir "...")
tempfile="T:MFMtemp"
dir=dir||"~(#?.info)" /* skip icons */
ADDRESS COMMAND List '>'||tempfile dir 'nohead quick all files lformat="%s%s"'
IF RC~=0 THEN CALL quit("Error while reading directory",10)
IF ~Open(temp,tempfile,"R") THEN CALL quit("Couldn't open temporary file:" tempfile,10)
TextBlockTypePrefs "SIZE 360 WIDTH 100"
proc=0
succ=0
SIGNAL ON BREAK_C
font=ReadLn(temp)
DO WHILE ~Eof(temp)
  i=Max(LastPos(font,':'),LastPos('/',font))
  name=DelStr(font,1,i)
  name=replacepat(replacepat(name," ","_"),"-","_") /* replace space and hyphen by underscore */
  proc=proc+1
  IF ~xexists(path||name) THEN
    DO
      CALL display(" Processing font:" name "...")
      TextBlockTypePrefs "FONT" font
      i=32
      /* Offset of baseline */
      DrawTextBlock 1 0 0 "W"
      o=RESULT
      SetObjectRotation o 90
      GetObjectCoords o
      PARSE VAR RESULT op ox oy ow oh
      DeleteObject o
      base=Trunc(Abs(oy)-ow/2)
      wr=D2C(base,2)
      DO WHILE i<256
        c=D2C(i)
        IF Verify(c,'";= ',"M")  THEN c='"'||c||'"'
        DrawTextBlock 1 0 0 c
        o=RESULT
        GetObjectCoords
        PARSE VAR RESULT p x y w h
        DeleteObject o
        wr=wr||D2C(w,2)
        IF i=126 THEN
          i=160
        ELSE
          i=i+1
        IF ~cmd THEN
          IF GetPkt(portname)~="00000000"x THEN CALL quit("Aborted.",0)
      END
      SIGNAL OFF BREAK_C /* atomic write operation */
      IF Open(out,path||name,"W") THEN
        DO
          CALL WriteCh(out,wr)
          CALL Close(out)
        END
      ELSE
        DO
          CALL Close(temp)
          CALL quit("Couldn't open file:" path||name,10)
        END
      SIGNAL ON BREAK_C
      succ=succ+1
    END
  ELSE
    CALL display(" Skipping font:" name "(already present)")
  font=ReadLn(temp)
END
CALL Close(temp)
ADDRESS COMMAND "Delete" tempfile

/* done */
CALL quit("Done.|" succ "new fonts added,|" proc-succ "fonts already present.",0)

/* -------------------- Subroutines ------------------------- */

BREAK_C: /* user abort */
  CALL Close(temp)
  CALL quit("User abort.")
RETURN

display: /* CALL display(string) */
  PARSE ARG string
  IF cmd THEN SAY string
RETURN

quit: /* CALL quit(string,errorcode) */
  PARSE ARG string,code
  string=replacepat(string,"|","0A"x)
  IF cmd | ~rqtools THEN
    SAY string
  ELSE
    CALL RTEzRequest(string,"OK","MakeFontMaps")
EXIT code

replacepat: PROCEDURE /* newstr=replacepat(str,pat,replc) */
  /* Replace all occurences of a pattern in a string by another one */
  PARSE ARG str,pat,replc
  p=Pos(pat,str)
  DO WHILE p>0
    str=Left(str,p-1)||replc||SubStr(str,p+Length(pat))
    p=Pos(pat,str)
  END
RETURN str

xexists: PROCEDURE /* bool=xexists(file) */
  PARSE ARG file
  IF Pos(":",file)>0 THEN
    IF Pos(Upper(Left(file,Pos(":",file))),Upper(ShowList("A",,":")||ShowList("V",,":"))||":")=0 THEN
      IF Right(file,1)=":" THEN /* might be deferred assign */
        DO
          ADDRESS COMMAND 'Assign >NIL: "'||file||'" Exists'
          IF RC>0 THEN RETURN 0 /* not found */
          /* ELSE (* Exists activates deferred assign *) */
        END
      ELSE
        RETURN 0
RETURN Exists(file)