tldm-universe/Ardent/UV/APP.PROGS/SET.PTR.B
2024-09-09 17:51:08 -04:00

274 lines
6.7 KiB
Plaintext
Executable File

********************************************************************************
*
* uniVerse port of PI/open !SETPTR subroutine
*
* Module %M% Version %I% Date %H%
*
* (c) Copyright 1998 Ardent Software Inc. - All Rights Reserved
* This is unpublished proprietary source code of Ardent Software Inc.
* The copyright notice above does not evidence any actual or intended
* publication of such source code.
*
*******************************************************************************
*
* Maintenence log - insert most recent change descriptions at top
*
* Date.... GTAR# WHO Description.........................................
* 10/14/98 23801 SAP Change copyrights.
* 10/23/95 16881 PGW Further MSWIN mods, & removed quotes from banner
* 10/05/95 16881 PGW Added support for new keys for Windows.
* 10/29/93 12299 LA Initial implementation.
*
*******************************************************************************
$OPTIONS INFORMATION
SUBROUTINE SET.PTR (UNIT, WIDTH, LENGTH, TOP, BOTTOM, MODE, OPTIONS)
$INCLUDE UNIVERSE.INCLUDE VERBINSERT.H
IF UNIT < 0 THEN
* Negative unit number means get current values, -1 means unit 0,
* -2 means unit 1 and so on
UNIT = -UNIT - 1
EXECUTE "SETPTR ":UNIT CAPTURING SETPTR.IO
* Need to extract values from result. Do this by getting the text
* for each value from the message file and searching the output for
* it.
TEXT = UVREADMSG(001031, "") ;* WIDTH
GOSUB GET.VALUE
WIDTH = VALUE
TEXT = UVREADMSG(001032, "") ;* LENGTH
GOSUB GET.VALUE
LENGTH = VALUE
TEXT = UVREADMSG(001033, "") ;* TOP MARGIN
GOSUB GET.VALUE
TOP = VALUE
TEXT = UVREADMSG(001034, "") ;* BOTTOM MARGIN
GOSUB GET.VALUE
BOTTOM = VALUE
TEXT = UVREADMSG(001035, "") ;* MODE
GOSUB GET.VALUE
MODE = FIELD(VALUE, " ", 1)
* Now the options - slightly more complicated as we have to set up
* text for them
OPTIONS = ""
SEP = ""
TEXT = UVREADMSG(001044, "") ;* FORM
GOSUB GET.VALUE
IF VALUE NE "" THEN
OPTIONS := SEP:"FORM ":VALUE
SEP = ", "
END
TEXT = UVREADMSG(001042, "") ;* BANNER + name
GOSUB GET.VALUE
IF VALUE NE "" THEN
* Remove quotes from banner string
IF VALUE[1,1] = '"' THEN
VALUE = VALUE[2, LEN(VALUE) - 2]
END
OPTIONS := SEP:"BANNER ":VALUE
SEP = ", "
END
TEXT = UVREADMSG(001043, "") ;* BANNER alone
GOSUB GET.VALUE
IF VALUE NE "" THEN
OPTIONS := SEP:"BANNER"
SEP = ", "
END
TEXT = UVREADMSG(015174, "") ;* BANNER as MS Windows job name
GOSUB GET.VALUE
IF VALUE NE "" THEN
* Remove quotes from banner string
IF VALUE[1,1] = '"' THEN
VALUE = VALUE[2, LEN(VALUE) - 2]
END
OPTIONS := SEP:"BANNER ":VALUE:",NOHEAD"
SEP = ", "
END
TEXT = UVREADMSG(001040, "") ;* LOCATION
GOSUB GET.VALUE
IF VALUE NE "" THEN
OPTIONS := SEP:"AT ":VALUE
SEP = ", "
END
TEXT = UVREADMSG(001045, "") ;* COPIES
GOSUB GET.VALUE
IF VALUE NE "" THEN
OPTIONS := SEP:"COPIES ":VALUE
SEP = ", "
END
TEXT = UVREADMSG(001041, "") ;* Suppress banner (NOHEAD)
GOSUB GET.VALUE
IF VALUE = "On" THEN
OPTIONS := SEP:"NOHEAD"
SEP = ", "
END
TEXT = UVREADMSG(001456, "")
GOSUB GET.VALUE
IF VALUE = "On" THEN
OPTIONS := SEP:"INFORM"
SEP = ", "
END
TEXT = UVREADMSG(001452, "") ;* RETAIN
GOSUB GET.VALUE
IF VALUE = "On" THEN
OPTIONS := SEP:"RETAIN"
SEP = ", "
END
TEXT = UVREADMSG(001455, "") ;* HOLD
GOSUB GET.VALUE
IF VALUE NE "" THEN
OPTIONS := SEP:VALUE
SEP = ", "
END
TEXT = UVREADMSG(001449, "")
GOSUB GET.VALUE
IF VALUE NE "" THEN
OPTIONS := SEP:"PRIORITY ":VALUE
SEP = ", "
END
TEXT = UVREADMSG(001300, "") ;* DEFER
GOSUB GET.VALUE
IF VALUE NE "" THEN
OPTIONS := SEP:"DEFER ":VALUE
SEP = ", "
END
TEXT = UVREADMSG(001297, "") ;* NOEJECT
GOSUB GET.VALUE
IF VALUE = "Off" THEN
OPTIONS := SEP:"NOEJECT"
SEP = ", "
END
TEXT = UVREADMSG(001298, "") ;* FTN
GOSUB GET.VALUE
IF VALUE = "On" THEN
OPTIONS := SEP:"FTN"
SEP = ", "
END
TEXT = UVREADMSG(001299, "") ;* LNUM
GOSUB GET.VALUE
IF VALUE = "On" THEN
OPTIONS := SEP:"LNUM"
SEP = ", "
END
TEXT = UVREADMSG(001453, "") ;* START PAGE
GOSUB GET.VALUE
IF VALUE NE "" THEN
VALUE = FIELD(VALUE, " ", 4)
VALUE = FIELD(VALUE, ",", 1)
OPTIONS := SEP:"STARTPAGE ":VALUE
SEP = ", "
END
TEXT = UVREADMSG(001454, "") ;* END PAGE
TEXT = FIELD(TEXT, " ", 2, 3)
FINDSTR TEXT IN SETPTR.IO, 1 SETTING FOUND THEN
VALUE = SETPTR.IO<FOUND>
FCOUNT = DCOUNT(VALUE, " ")
VALUE = FIELD(VALUE, " ", FCOUNT)
VALUE = TRIM(FIELD(VALUE, ".", 1), " ", "B")
OPTIONS := SEP:"ENDPAGE ":VALUE
SEP = ", "
END
TEXT = UVREADMSG(001341, "") ;* BANNER NEXT
GOSUB GET.VALUE
IF VALUE NE "" THEN
OPTIONS := SEP:"BANNER NEXT ":VALUE
SEP = ", "
END
* TEXT = UVREADMSG(001448,
TEXT = UVREADMSG(001296, "") ;* NOFMT
GOSUB GET.VALUE
IF VALUE = "Off" THEN
OPTIONS := SEP:"NOFMT"
SEP = ", "
END
TEXT = UVREADMSG(001342, "") ;* KEEP
GOSUB GET.VALUE
IF VALUE = "On" THEN
OPTIONS := SEP:"KEEP"
SEP = ", "
END
TEXT = UVREADMSG(015118, "") ;* FONTBOLD
GOSUB GET.VALUE
IF VALUE = "On" THEN
OPTIONS := SEP:"FONTBOLD"
SEP = ", "
END
TEXT = UVREADMSG(015119, "") ;* FONTITALIC
GOSUB GET.VALUE
IF VALUE = "On" THEN
OPTIONS := SEP:"FONTITALIC"
SEP = ", "
END
TEXT = UVREADMSG(015120, "") ;* FONTNAME
GOSUB GET.VALUE
IF VALUE NE "" THEN
OPTIONS := SEP:"FONTNAME ":VALUE
SEP = ", "
END
TEXT = UVREADMSG(015121, "") ;* FONTSIZE
GOSUB GET.VALUE
IF VALUE NE "" THEN
OPTIONS := SEP:"FONTSIZE ":VALUE
SEP = ", "
END
TEXT = UVREADMSG(015124, "") ;* GDI
GOSUB GET.VALUE
IF VALUE = "On" THEN
OPTIONS := SEP:"GDI"
SEP = ", "
END
TEXT = UVREADMSG(015122, "") ;* LINESPACE
GOSUB GET.VALUE
IF VALUE NE "" THEN
OPTIONS := SEP:"LINESPACE ":VALUE
SEP = ", "
END
TEXT = UVREADMSG(015125, "") ;* RAW
GOSUB GET.VALUE
IF VALUE = "On" THEN
OPTIONS := SEP:"RAW"
SEP = ", "
END
TEXT = UVREADMSG(015123, "") ;* TABSIZE
GOSUB GET.VALUE
IF VALUE NE "" THEN
OPTIONS := SEP:"TABSIZE ":VALUE
SEP = ", "
END
END ELSE
* Setting parameters, make sure we add BRIEF so that SETPTR doesn't
* query user
CMD = "SETPTR ":UNIT:",":WIDTH:",":LENGTH:",":TOP:",":BOTTOM:",":MODE
CMD := ",":OPTIONS:",BRIEF"
EXECUTE CMD CAPTURING SETPTR.IO
END
RETURN
*****************************************************************************
GET.VALUE:
TEXT = FIELD(TEXT, ":", 1)
TEXT = TRIM(TEXT, " ", "B")
FINDSTR TEXT IN SETPTR.IO, 1 SETTING FOUND THEN
VALUE = SETPTR.IO<FOUND>
VALUE = FIELD(VALUE, ":", 2)
VALUE = TRIM(VALUE, " ", "B")
END ELSE
VALUE = ""
END
RETURN
END