Author Topic: Install TTF Fonts with Rexx  (Read 3262 times)

Jan-Erik Lärka

  • Global Moderator
  • Full Member
  • *****
  • Thank You
  • -Given: 5
  • -Receive: 11
  • Posts: 151
    • View Profile
Install TTF Fonts with Rexx
« on: June 07, 2013, 03:03:07 pm »
Hello,

you should all have alot of packages with ttf-fonts that you want to add to your system.
The script here will unpack and add them so you can use them after the next reboot.

//Jan-Erik

Code: [Select]
/*
 * Filename: InstFonts.cmd
 *   Author: JAN-ERIK
 *  Created: Sun Mar 31 2013
 *  Purpose: Unpack .zip-files that contain .ttf fonts and add them to your OS/2-eCS system
 *  Changes:
 */

ttfs = 'C:\PSFONTS\TTF' /* Unpack/Install to path */

IF RxLoadLib( 'UZLoadFuncs', 'UNZIP32' ) <> '' THEN
DO
    IF DATATYPE( STRIP( unzipver ), 'N' ) THEN exeunzip = 1
    ELSE exeunzip = -1
END
ELSE exeunzip = 0

IF exeunzip < 0 THEN
DO
    CALL LINEOUT 'STDERR', 'UnZip not found, please install it'
    RETURN 1
END

IF RxLoadLib( 'SysLoadFuncs', 'rexxutil' ) <> '' THEN
DO
    CALL LINEOUT 'STDERR', 'RexxUtil not found, please install it'
    RETURN 2
END

PARSE ARG path
path = STRIP( path, 'T', '\' )
PARSE SOURCE . . this
this = STRIP( FILESPEC( 'D', this )||FILESPEC( 'P', this ), 'T', '\' )
IF LENGTH( path ) = 0 THEN RETURN Usage()
IF DIRECTORY( path ) = '' THEN RETURN Usage()
CALL DIRECTORY this

rc = SysFileTree( path||'\*.zip', 'pkg.', 'SFO' )
DO i = 1 TO pkg.0 + 1
    CALL rxWorking 1, 'Processing '||pkg.i
    CALL rxProgress 2, ( i - 1 ) / ( pkg.0 + 1 ), 0
    IF exeunzip = 0 THEN
        CALL UZUnZip '-n -j '||pkg.i||' *.ttf -d '||ttfs, 'font.'
    ELSE IF exeunzip = 1 THEN
    DO
        DO WHILE QUEUED() > 0; PARSE PULL; END;
        '@UNZIP -n -j '||pkg.i||' *.ttf -d '||ttfs||'|RXQUEUE'
        j = 0
        DO WHILE QUEUED() > 0
            j = j + 1
            font.j = LINEIN( 'QUEUE:' )
            font.0 = j
        END
        DO WHILE QUEUED() > 0; PARSE PULL; END;
    END
    DO j = 1 TO font.0
        CALL rxProgress 2, i / ( pkg.0 + 1 ), ( i - 1 + j / font.0 ) / ( pkg.0 + 1 )
        PARSE VALUE REVERSE( font.j ) WITH ext'.'filename'/'filepath' :'.
        IF TRANSLATE( STRIP( ext ) ) = 'FTT' THEN
        DO
            font.j.fontname = REVERSE( filename )
            CALL rxWorking 1, 'Adding "'||font.j.fontname||'"'
            CALL RegisterFont font.j.fontname, TRANSLATE( REVERSE( filepath ), '\', '/' )||'\'||font.j.fontname||'.ttf'
        END
    END
END
rc = SysFileTree( path||'\*.ttf', 'file.', 'SFO' )
DO i = 1 TO file.0
    CALL rxProgress 2, pkg.0 / ( pkg.0 + 1 ), ( pkg.0 + i / file.0 / ( pkg.0 + 1 ) )
    IF SysCopyObject( file.i, ttfs ) THEN
    DO
        PARSE VALUE REVERSE( file.i ) WITH .'.'filename'\'
        filename = REVERSE( filename )
        CALL rxWorking 1, 'Adding "'||filename||'"'
        CALL RegisterFont filename, file.i
    END
END
CALL CleanupInstalledFonts
CALL rxProgress 2, 1
RETURN

Usage: PROCEDURE
    PARSE SOURCE . . scriptname
    PARSE VALUE REVERSE( FILESPEC( 'N', scriptname ) ) WITH .'.'scriptname
    CALL LINEOUT 'STDOUT', 'Usage:'
    CALL LINEOUT 'STDOUT', '      '||REVERSE( scriptname )||' C:\My\Zipped\Fonts'
RETURn 0

RxLoadLib: PROCEDURE
    SIGNAL ON SYNTAX NAME Faulty
    CALL RxFuncAdd ARG(1), ARG(2), ARG(1)
    INTERPRET 'CALL '||ARG(1)
RETURN ''
Faulty:
RETURN "Couldn't load "||ARG(2)||".dll and register "||ARG(1)||"!"

/* display_on_row, part  */
rxProgress: PROCEDURE EXPOSE  __meter. !_sqleng_!. !_tmp_table_!
    IF TRACE() = '?I' THEN RETURN 0
    row = ARG(1)
    IF SYMBOL( "__meter.row.t_stamp" ) = "VAR" THEN
        IF __meter.row.t_stamp + 1 > TIME( 'S' ) THEN RETURN 0
    chr = 'Û²±°þÛ ' /* you may have to replace the varaible value with ░▒▓█■█ */
    IF SYMBOL( "__meter.width" ) <> "VAR" THEN
        PARSE VALUE SysTextScreenSize() WITH __meter.height __meter.width
    ELSE IF \DATATYPE( __meter.width, 'W' ) THEN
        PARSE VALUE SysTextScreenSize() WITH __meter.height __meter.width
    DO i = 2 TO MIN( ARG(), LENGTH( chr ) )
        j = i - 1
        IF LENGTH( ARG(i) ) = 0 THEN progress.j = 1
        ELSE IF \DATATYPE( ARG(i), 'N' ) THEN RETURN 0
        ELSE progress.j = FORMAT( ARG(i),,, 0 )
        IF LENGTH( FORMAT( 100 * progress.j,, 0, 0 ) ) > 3 THEN
            RETURN 0
    END
    progress.0 = j
    processed.0 = 0
    output = ''
    CALL SysStemSort 'progress'
    DO i = 1 TO MIN( progress.0, LENGTH( chr ) )
        j = i - 1
        processed.i = FORMAT( MIN( ( __meter.width - 4 ) * progress.i , __meter.width - 4 ),, 0, 0 )
        progress.i = FORMAT( 100 * progress.i, 3, 0, 0 )

        IF processed.i > processed.j THEN
            output = output||COPIES( SUBSTR( chr, i, 1 ), processed.i - processed.j )
    END
    i = i - 1
    output = output||COPIES( SUBSTR( chr, LENGTH( chr ), 1 ), __meter.width - 4 - processed.i )
    CALL rxOut ARG(1), output||RIGHT( progress.1||'%', 4 )
RETURN 0

/* display_on_row, text  */
rxWorking: PROCEDURE EXPOSE __meter. !_sqleng_!. !_tmp_table_!
    IF TRACE() = '?I' THEN RETURN 0
    PARSE ARG row, txt
    IF SYMBOL( "__meter."||row||".t_stamp" ) <> "VAR" THEN
        __meter.row.t_stamp = TIME( 'S' )
    ELSE IF \DATATYPE( __meter.row.t_stamp , 'N' ) THEN
        __meter.row.t_stamp = TIME( 'S' )
    IF __meter.row.t_stamp + 1 < TIME( 'S' ) THEN
    DO
        SELECT
            WHEN __meter.counter = 1 THEN
                CALL rxOut row, '/ '||txt
            WHEN __meter.counter = 2 THEN
                CALL rxOut row, '- '||txt
            WHEN __meter.counter = 3  THEN
                CALL rxOut row, '\ '||txt
            OTHERWISE
            __meter.counter = 0
            CALL rxOut row, '| '||txt
        END
        __meter.counter = __meter.counter + 1
    END
RETURN 0

/* display_on_row, text  */
rxOut: PROCEDURE EXPOSE __meter. !_sqleng_!. !_tmp_table_!
    IF TRACE() = '?I' THEN RETURN 0
    PARSE ARG row, txt
    IF SYMBOL( "__meter.width" ) <> "VAR" THEN
        PARSE VALUE SysTextScreenSize() WITH __meter.height __meter.width
    IF SYMBOL( "__meter."||row||".t_stamp" ) <> "VAR" THEN
        __meter.row.t_stamp = TIME( 'S' )
    IF \DATATYPE( __meter.row.t_stamp, 'W' ) | \DATATYPE( __meter.width, 'W' ) THEN
        PARSE VALUE SysTextScreenSize() WITH __meter.height __meter.width
    isNum = DATATYPE( row, 'W' )
    IF isNum THEN
    DO
        IF DATATYPE( __meter.row.t_stamp, 'W' ) THEN
            IF __meter.row.t_stamp + 1 > TIME( 'S' ) THEN RETURN 0
        PARSE VALUE SysCurPos( row, 0 ) with prev_row prev_col
    END
            ELSE IF DATATYPE( __meter.row.t_stamp, 'W' ) THEN
                IF __meter.row.t_stamp + 1 > TIME( 'S' ) THEN RETURN 0
    CALL CHAROUT 'STDERR', LEFT( txt, MAX( __meter.width, MIN( LENGTH( txt ), __meter.width ) ) )
    IF isNum THEN
    DO
        CALL SysCurPos prev_row, prev_col
        __meter.row.t_stamp = TIME( 'S' )
    END
    ELSE
        __meter.row.t_stamp = TIME( 'S' )
RETURN 0

/* Register a font in the desktop INI file.  The font will be available to PM
 * after the next startup.
 */
RegisterFont: PROCEDURE EXPOSE log1
    PARSE ARG fontname, filename

    inirc = SysIni( 'USER', 'PM_Fonts', fontname, filename || '00'x )
    IF inirc == '' THEN
        CALL rxOut 1, ' - Registered "'fontname'" in profile.'
    ELSE
        CALL rxOut 3, ' - Failed to register "'fontname'" in profile:' inirc
RETURN 0

/* Check all registered fonts in OS2.INI and make sure they're actually
 * installed.  Deregister any non-existent font.
 */
CleanupInstalledFonts: PROCEDURE EXPOSE log1

    ok = SysIni( 'USER', 'PM_Fonts', 'ALL:', 'regfonts.' )
    IF ok == 'ERROR:' THEN RETURN 1

    CALL rxOut 1, 'Verifying' regfonts.0 'registered fonts...'
    DO i = 1 TO regfonts.0
        PARSE VALUE SysIni( 'USER', 'PM_Fonts', regfonts.i ) WITH _font '00'x .
        IF _font == 'ERROR:' THEN ITERATE
        IF STREAM( _font, 'C', 'QUERY EXISTS' ) == '' THEN DO
            CALL rxOut 3, 'Registered font' _font 'does not exist - deregistering.'
            ok = SysIni( 'USER', 'PM_Fonts', regfonts.i, 'DELETE:' )
            IF ok == 'ERROR:' THEN CALL rxOut 3, 'Deregistering of font' _font 'failed!'
        END
    END

RETURN 0



Andi B.

  • Sr. Member
  • ****
  • Thank You
  • -Given: 1
  • -Receive: 12
  • Posts: 310
    • View Profile
Re: Install TTF Fonts with Rexx
« Reply #1 on: June 07, 2013, 05:11:33 pm »
Seems you are using fixed drive setting C:\. I never used C:\ for installing eCS or OS/2 but a lot of other different drive letters. Shouldn't it be possible to use bootdrive instead? Though never tried to get 'bootdrive' in REXX by myself.

Alex Taylor

  • Full Member
  • ***
  • Thank You
  • -Given: 10
  • -Receive: 14
  • Posts: 218
    • View Profile
Re: Install TTF Fonts with Rexx
« Reply #2 on: June 07, 2013, 05:21:13 pm »
Use InstFont and you won't have to reboot (unless you're updating a previously-installed font, perhaps).

Jan-Erik Lärka

  • Global Moderator
  • Full Member
  • *****
  • Thank You
  • -Given: 5
  • -Receive: 11
  • Posts: 151
    • View Profile
Re: Install TTF Fonts with Rexx
« Reply #3 on: June 10, 2013, 08:05:28 am »
You're both right!

There are functions to retrieve the boot drive, but also environment variables to use for backup if the function is not available.
Code: [Select]
ttfs = SysBootDrive()||'\PSFONTS\TTF'Please note that the function is only available with newer rexxutil from Object REXX. So plain vanilla Warp 4 doesn't have it I guess by default, but eCS does.

I looked at your instfont exe Alex and the source code before I wrote the script. It would be very interesting as part of a rexx library, perhaps your RxULS!

This script add all fonts and require a reboot.

Jan-Erik Lärka

  • Global Moderator
  • Full Member
  • *****
  • Thank You
  • -Given: 5
  • -Receive: 11
  • Posts: 151
    • View Profile
Re: Install TTF Fonts with Rexx
« Reply #4 on: June 10, 2013, 08:19:51 am »
Code: [Select]
IF \RxFuncQuery( 'SysBootDrive' ) THEN
  boot_drive = SysBootDrive()
ELSE
  PARSE VALUE VALUE( 'OS2_SHELL' ) WITH boot_drive'\OS2\CMD.EXE'
IF boot_drive = '' THEN RETURN 99
ttfs = boot_drive||'\PSFONTS\TTF'

Alex Taylor

  • Full Member
  • ***
  • Thank You
  • -Given: 10
  • -Receive: 14
  • Posts: 218
    • View Profile
Re: Install TTF Fonts with Rexx
« Reply #5 on: June 10, 2013, 11:15:56 pm »
There are functions to retrieve the boot drive, but also environment variables to use for backup if the function is not available.
Code: [Select]
ttfs = SysBootDrive()||'\PSFONTS\TTF'Please note that the function is only available with newer rexxutil from Object REXX. So plain vanilla Warp 4 doesn't have it I guess by default, but eCS does.

The so-called "Object REXX" functions were added to the standard REXXUTIL in Warp 4 with FixPak 6 (and to Warp 3 in FixPak 35). 


Quote
I looked at your instfont exe Alex and the source code before I wrote the script. It would be very interesting as part of a rexx library, perhaps your RxULS!

Better in RXUTILEX (and it's on my TODO list, in fact).