/*
   $VER: CreateMonitor 1.2 (12.01.93)
   Arexx Script, erzeugt Werte für die RETINA NewMonitorStruktur.
   © Januar 1993, MS MacroSystem Computer GmbH, written by Bernd Gronemann.
*/
OPTIONS RESULTS
ADDRESS COMMAND
signal on break_c

call Init                  /* Initialisieren */

parse ARG Zeile
call ParseZeile            /* Parameter holen */
ModiFaktor = 4
if upper(Modi) = 'P' then
   ModiFaktor = 8

if OK & datatype(Pixel) = 'NUM' & datatype(HFreq) = 'NUM' & Pixel ~= '' & HFreq ~= '' & datatype(Bits) = 'NUM' & Bits ~= '' & datatype(Aspect) = 'NUM' & Aspect ~= '' then
do
/* Anzahl der Bytes pro Pixel bestimmen */
   select
      when Bits = 24 then
         PBytes = 3
      when Bits = 15 | Bits = 16 then
         PBytes = 2
      otherwise
         PBytes = 1
   end

   if Bits ~= 8 & upper(Modi) = 'P' then
   do
      say '!! Abbruch !!   Planarer Modi zur Zeit nicht in dieser Farbauflösung möglich'
      exit
   end

/*
   do while Pixel//ModiFaktor ~= 0
      Pixel = Pixel + 1
   end
*/

/* Anzahl der Zeilen bestimmen */
   select
      when Aspect = 2 then
         AnzZeilen = trunc(Pixel / 2.66667)
      when Aspect = 1 then
         AnzZeilen = trunc(Pixel / 1.33333)
      otherwise
         AnzZeilen = Aspect
   end

/* Anzahl der Zeilen Interlace anpassen */
   if upper(Flags) = 'I' then
      if (AnzZeilen//2) = 1 then
         AnzZeilen = AnzZeilen + 1

/* Horizontal */
   if HFreq = '15625' then
      HTotal = 1.2307 * Pixel * PBytes          /* Default HTotal bestimmen */
   else do
      HTotal = 1.25 * Pixel * PBytes            /* Default HTotal bestimmen */
   end
   PFreq = HFreq * HTotal
   if PFreq < 10000000 | PFreq > 100000000 then
   do
      say '!! Abbruch !!   PixelTakt nicht im erlaubten Bereich'
      exit
   end

/* Passende Pixelfrequenz ermitteln */
   if upper(PlusMinus) = 'Y' then
      call BestPixelFreqPlusMinus(PFreq)     /* neue Pixelfrequenz, auch kleinere als erforderlich */
   else do
      call BestPixelFreq(PFreq)              /* neue Pixelfrequenz */
   end


   HTotalDiff = HTotal - (Pixel * PBytes)
   NewHTotalDiff = NewHTotal - (Pixel * PBytes)
   HTotalDiffFaktor = NewHTotalDiff / HTotalDiff
   if HTotalDiffFaktor < 1 & HardPFreq = 90000000 then
      say ';!! Warnung !!   HSync und HBlank werden verkürzt'

/* Bestimmung der Horizontalfaktoren */
   call GetHorizontalWerte

/* Character-Werte ermitteln */
   HBStart = trunc((Pixel * PBytes)/ModiFaktor) +1              /* +1 rechter Rand !!! */
   HSStart = trunc((Pixel * PBytes * HSStartFaktor)/ModiFaktor)
   HSEnd = trunc((Pixel * PBytes * HSEndFaktor)/ModiFaktor)
   HTotal = trunc((Pixel * PBytes * HTotalFaktor)/ModiFaktor) -5
   HBEndModulo = ((HTotal * ModiFaktor)//3)+1                   /* Modulo Wert für */
   if HBEndModulo = 3 then                                      /* HBEnd ermitteln */
      HBEndModulo = 0                                           /* Farbfehler 24 Bit */
   if Bits = '24' then
   do
      HBEnd = trunc((Pixel * PBytes * HBEndFaktor)/ModiFaktor) -5  /* *4 modulo 3 */
      do while (HBEnd * ModiFaktor)//3 ~= HBEndModulo
         HBEnd = HBEnd - 1
      end
   end
   else do
      HBEnd = trunc((Pixel * PBytes * HBEndFaktor)/ModiFaktor) -5  /* *4 modulo 3 */
   end

/* Warnung bei total falschen Horizontalwerten */
   if HTotal < HBEnd | HBEnd < HSEnd | HSEnd < HSStart | HSStart < HBStart | HSStart >1023 | HBStart >1023 | HTotal >1023 then
   do
      say ';!! Warnung !!   HSync oder HBlank nicht im erlaubten Bereich'
/*
      exit
*/
   end

/* Vertikalwerte berechnen */
/* Bestimmung der Vertikalfaktoren */
   call GetVertikalWerte

/* Abbruch bei total falschen Vertikalwerten */
   if VTotal < VBEnd | VBEnd < VSEnd | VSEnd < VSStart | VSStart < VBStart | VSStart > 2047 | VBStart > 2047 then
   do
      say '!! Abbruch !!   VSync oder VBlank nicht im erlaubten Bereich'
      exit
   end

/* Ausgabe der Frequenzen */
   HFreq = trunc(BestPFreq / ((HTotal+5)*ModiFaktor))
   if upper(Modi) = 'P' then
      Frequenzen = '; PLANAR   '
   else
      Frequenzen = '; '
   Frequenzen = Frequenzen'HFreq: 'HFreq' Hz, VFreq: 'VFreq' Hz'

/* ASM Source Generierung */
   if ASS then
      call ASMSource
   else do
      call AddMonitorParam
   end
end
exit

break_c:
say "Control-C break"
exit 10

Init:
/* Variablenfeld mit zur Verfügung stehenden Pixelfrequenzen erstellen */
NormPFreq = 25175000 28322000 36000000 65000000 44900000 50000000 80000000 75000000 56644000 63000000 72000000 90000000
I = 0
do until NormPFreq = ''
   I = I + 1
   parse VAR NormPFreq NormPFreq.I ' ' NormPFreq
end
NormPFreq.0 = I
return

ParseZeile:                /* Parameter einlesen */
ASS = 0
OK = 1
Rest = Zeile
do until Rest = '' | ~OK
   parse VAR Rest Param' 'Wert' 'Rest
   select
      when (upper(Param) = 'WIDTH' | upper(Param) = 'W') & datatype(Wert) = 'NUM' then
         Pixel = Wert
      when (upper(Param) = 'HEIGHT' | upper(Param) = 'H') & datatype(Wert) = 'NUM' then
         Aspect = Wert
      when (upper(Param) = 'FREQ' | upper(Param) = 'F') & datatype(Wert) = 'NUM' then
         HFreq = Wert
      when (upper(Param) = 'BITS' | upper(Param) = 'B') & datatype(Wert) = 'NUM' then
         Bits = Wert
      when (upper(Param) = 'OPTIONS' | upper(Param) = 'O') & datatype(Wert) = 'CHAR' then
         Flags = Wert
      when (upper(Param) = 'MODI' | upper(Param) = 'M') & datatype(Wert) = 'CHAR' then
         Modi = Wert
      when (upper(Param) = 'PLUSMINUS' | upper(Param) = 'PM') & datatype(Wert) = 'CHAR' then
         PlusMinus = Wert
      when (upper(Param) = 'ASS') & Wert = '' then
         ASS = 1
      otherwise
         OK = 0
         call ParameterHelp
   end
end
return

ParameterHelp:                                          /* Hilfeausgabe */
if Pixel = '?' | Zeile = '?' then
do
   say 'CreateMonitor W=WIDTH/A/K/N,H=HEIGHT/A/K/N,F=FREQ/A/K/N,B=BITS/A/K/N,O=OPTIONS/K,M=MODI/K,PM=PLUSMINUS/K: '
   pull InLine
   if InLine = '?' then
   do
      say 'CreateMonitor'
      say '© 1992,1993 MS MacroSystem Computer GmbH'
      say '            written by Bernd Gronemann'
      say ' '
      say 'WIDTH:       Breite in Pixel pro Zeile'
      say 'HEIGHT:      Höhe in Zeilen, oder Aspect Ratio, 1 = 1:1, 2 = 2:1'
      say 'FREQ:        Horizontalfrequenz in Hz'
      say 'BITS:        Farbauflösung in 8, 16 oder 24 Bit pro Pixel'
      say 'OPTIONS:     I = Interlace, D = Doublescan'
      say 'MODI:        P = Planar ( für WB-Emulation )'
      say 'PLUSMINUS:   Y = Yes'
      say ' '
   end
   Zeile = InLine
   call ParseZeile
end
else do
   say 'CreateMonitor: falscher Parameter'
end
return

Circa: PROCEDURE           /* Test ob Variable in erlaubten Bereich liegt */
parse arg TestVar,Ziel,Abweichung
if abs((TestVar/Ziel)-1) < Abweichung then
   Flag = 1
else do
   Flag = 0
end
return(Flag)

BestPixelFreq:             /* beste Pixelfrequenz ermitteln */
Klein = 10
HardPFreq = 90000000
BestPFreq = 90000000
CLKFlag = ''
do I = 1 to NormPFreq.0
   Faktor.I = ((NormPFreq.I / PFreq) - 1)
   if Faktor.I < 0 then                         /* keine PixelFrequenzen zulassen, */
      Faktor.I = 10                             /* die kleiner als die Gewünschte ist */
   Faktor2.I = ((NormPFreq.I / (2 * PFreq)) - 1)
   if Faktor2.I < 0 then                        /* keine PixelFrequenzen zulassen, */
      Faktor2.I = 10                            /* die kleiner als die Gewünschte ist */
   if Faktor.I < Klein & Faktor.I >= 0 then
   do
      Klein = Faktor.I
      HardPFreq = NormPFreq.I
      BestPFreq = HardPFreq
      CLKFlag = ''
   end
   if Faktor2.I < Klein & Faktor2.I >= 0 then
   do
      Klein = Faktor2.I
      HardPFreq = NormPFreq.I
      BestPFreq = HardPFreq / 2
      CLKFlag = 'MDF_CLKDIV2'
   end
end
NewHTotal = BestPFreq / HFreq                         /* neue Zeilenlänge in Pixel */
return()

BestPixelFreqPlusMinus:    /* beste Pixelfrequenz ermitteln */
Klein = 10
HardPFreq = 90000000
CLKFlag = ''
do I = 1 to NormPFreq.0
   Faktor.I = abs((NormPFreq.I / PFreq) - 1)
   Faktor2.I = abs((NormPFreq.I / (2 * PFreq)) - 1)
   if Faktor.I < Klein & Faktor.I >= 0 then
   do
      Klein = Faktor.I
      HardPFreq = NormPFreq.I
      BestPFreq = HardPFreq
      CLKFlag = ''
   end
   if Faktor2.I < Klein & Faktor2.I >= 0 then
   do
      Klein = Faktor2.I
      HardPFreq = NormPFreq.I
      BestPFreq = HardPFreq / 2
      CLKFlag = 'MDF_CLKDIV2'
   end
end
NewHTotal = BestPFreq / HFreq                         /* neue Zeilenlänge in Pixel */
return()


GetHorizontalWerte:        /* Horizontalwerte bestimmen */
select
   when Circa(HFreq,15625,0.02) then      /* Test auf 15625 kHz */
   do
      HSStartFaktor  = 1 + 0.0288 * HTotalDiffFaktor
      HSEndFaktor    = 1 + 0.1192 * HTotalDiffFaktor
      HBEndFaktor    = 1 + 0.2307 * HTotalDiffFaktor
      HTotalFaktor   = 1 + 0.2307 * HTotalDiffFaktor
   end
   when Circa(HFreq,31468,0.02) then      /* Test auf 31468 kHz */
   do
      HSStartFaktor  = 1 + 0.075 * HTotalDiffFaktor        /* 0.075, vorher 0.025 !!! */
      HSEndFaktor    = 1 + 0.175 * HTotalDiffFaktor
      HBEndFaktor    = 1 + 0.25 * HTotalDiffFaktor
      HTotalFaktor   = 1 + 0.25 * HTotalDiffFaktor
   end
   when Circa(HFreq,35520,0.02) then      /* Test auf 35520 kHz */
   do
      HSStartFaktor  = 1 + 0.01 * HTotalDiffFaktor
      HSEndFaktor    = 1 + 0.06 * HTotalDiffFaktor
      HBEndFaktor    = 1 + 0.23 * HTotalDiffFaktor
      HTotalFaktor   = 1 + 0.23 * HTotalDiffFaktor
   end
   when Circa(HFreq,38000,0.02) then      /* Test auf 38000 kHz */
   do
      HSStartFaktor  = 1 + 0.025 * HTotalDiffFaktor
      HSEndFaktor    = 1 + 0.175 * HTotalDiffFaktor
      HBEndFaktor    = 1 + 0.25 * HTotalDiffFaktor
      HTotalFaktor   = 1 + 0.25 * HTotalDiffFaktor
   end
   otherwise                              /* alle anderen Horizontalfrequenzen */
      HSStartFaktor  = 1 + 0.025 * HTotalDiffFaktor
      HSEndFaktor    = 1 + 0.175 * HTotalDiffFaktor
      HBEndFaktor    = 1 + 0.25 * HTotalDiffFaktor
      HTotalFaktor   = 1 + 0.25 * HTotalDiffFaktor
end
return

GetVertikalWerte:          /* Vertikalwerte bestimmen */
if Circa(HFreq,15625,0.02) then
do
   VBStart  = trunc(AnzZeilen)
   VSStart  = trunc(AnzZeilen * 1.0087)
   VSEnd    = trunc(AnzZeilen * 1.0174)
   VBEnd    = trunc(AnzZeilen * 1.0261)
   VTotal   = trunc(AnzZeilen * 1.0877)
end
else do
   if upper(Flags) ~= 'I' then
   do
      VBStart  = trunc(AnzZeilen)
      VSStart  = trunc(AnzZeilen * 1.0209)
      VSEnd    = trunc(AnzZeilen * 1.025)
      VBEnd    = trunc(AnzZeilen * 1.094)
      VTotal   = trunc(AnzZeilen * 1.094)
   end
   else do
      VBStart  = trunc(AnzZeilen)
      VSStart  = trunc(AnzZeilen * 1.00185)
      VSEnd    = trunc(AnzZeilen * 1.012)
      VBEnd    = trunc(AnzZeilen * 1.064)
      VTotal   = trunc(AnzZeilen * 1.064)
   end
end

/* Anpassung der Werte an Interlace und DoubleScan*/
select
   when upper(Flags) = 'I' then do
      VBStart  = trunc(VBStart/2)
      if VBStart * 2 < AnzZeilen then
         VBStart = VBStart + 1
      VSStart  = trunc(VSStart/2)
      VSEnd    = trunc(VSEnd/2)
      VBEnd    = trunc(VBEnd/2)
      VTotal   = trunc(VTotal/2)
      VFreq    = (trunc(HFreq / VTotal * 10)) / 10    /* absichtlich Kommawerte zur */
   end                                                /* Abschätzung der Frequenz */
   when upper(Flags) = 'D' then do
      VBStart  = VBStart*2
      VSStart  = VSStart*2
      VSEnd    = VSEnd*2
      VBEnd    = VBEnd*2
      VTotal   = VTotal*2
      VFreq    = (trunc(HFreq / VTotal * 10)) / 10    /* absichtlich Kommawerte zur */
   end                                                /* Abschätzung der Frequenz */
   otherwise
      VBStart  = VBStart
      VSStart  = VSStart
      VSEnd    = VSEnd
      VBEnd    = VBEnd
      VTotal   = VTotal
      VFreq    = (trunc(HFreq / VTotal * 10)) / 10    /* absichtlich Kommawerte zur */
end                                                   /* Abschätzung der Frequenz */
return

ASMSource:                 /* Ausgabe des ASM-Source Textes */
call GetMonitorID
call GetMonitorFlags

ASMFrequenzen = Frequenzen

ASMID = '	dc.l	'MONID
ASMFlags = '	dc.b	'MONFlags
ASMPixelFreq = '	dc.l	'HardPFreq
ASMAtntMode = '	dc.b	ATNT_MODE_'Bits
ASMStdAufloesung = '	dc.w	'Pixel','AnzZeilen
ASMMaxAufloesung = '	dc.w	'Pixel','AnzZeilen
ASMHBStart  = '	dc.w	'HBStart
ASMHSStart  = '	dc.w	'HSStart
ASMHSEnd    = '	dc.w	'HSEnd
ASMHBEnd    = '	dc.w	'HBEnd
ASMHTotal   = '	dc.w	'HTotal
ASMVBStart  = '	dc.w	'VBStart
ASMVSStart  = '	dc.w	'VSStart
ASMVSEnd    = '	dc.w	'VSEnd
ASMVBEnd    = '	dc.w	'VBEnd
ASMVTotal   = '	dc.w	'VTotal

/* Ausgabe der Frequenzen */
say ASMFrequenzen

/* ASM Source Ausgabe */
say '	XDEF	NewMon_Def'
say 'NewMon_Def:'
say ASMID'	; MonitorID'
say ASMPixelFreq'	; PixelFreq'
say ASMAtntMode'	; AtntMode'
say ASMFlags'	; Flags'
say ASMStdAufloesung'	; StdAufloesung'
say ASMMaxAufloesung'	; MaxAufloesung'
say ASMHBStart'	; HBStart'
say ASMHSStart'	; HSStart'
say ASMHSEnd  '	; HSEnd'
say ASMHBEnd  '	; HBEnd'
say ASMHTotal '	; HTotal'
say ASMVBStart'	; VBStart'
say ASMVSStart'	; VSStart'
say ASMVSEnd  '	; VSEnd'
say ASMVBEnd  '	; VBEnd'
say ASMVTotal '	; VTotal'
say '	end'
return

AddMonitorParam:           /* Ausgabe der Parameter für AddMonitor */
call GetMonitorID
call GetMonitorFlags
/* Ausgabe der Frequenzen */
say Frequenzen
/* Ausgabe der ID, PixelFreq, Mode, Flags */
say 'ID	'MONID
say 'FQ	'HardPFreq
say 'MD	ATNT_MODE_'Bits
say 'FLG	'MONFlags
say 'SW	'Pixel
say 'SH	'AnzZeilen
say 'MW	'Pixel
say 'MH	'AnzZeilen

/* Ausgabe der Horizontalwerte */
say 'HBS	'HBStart
say 'HSS	'HSStart
say 'HSE	'HSEnd
say 'HBE	'HBEnd
say 'HT	'HTotal

/* Ausgabe der Vertikalwerte */
say 'VBS	'VBStart
say 'VSS	'VSStart
say 'VSE	'VSEnd
say 'VBE	'VBEnd
say 'VT	'VTotal

return

GetMonitorID:                                           /* MonitorID erzeugen */
MONID = ''
/* Farbauflösung Bit pro Pixel */
select
   when Bits = 24 then
      MONID = 'MONCOL_24'                               /* 24 Bit */
   when Bits = 16 then
      MONID = 'MONCOL_16'                               /* 16 Bit */
   otherwise
      MONID = 'MONCOL_8'                                /* 8 Bit */
end
/* MonitorID */
select
   when Circa(HFreq,15625,0.02) & Circa(VFreq,50,0.02) then
      MONID = MONID'|MONID_PAL'                         /* PAL */
   when Circa(HFreq,15734,0.02) & Circa(VFreq,60,0.02) then
      MONID = MONID'|MONID_NTSC'                        /* NTSC */
   when Circa(HFreq,31500,0.02) then                    /* 31500 kHz */
   do
      select
         when Circa(VFreq,50,0.04) then
            MONID = MONID'|MONID_VGA50'                 /* VGA50 */
         when Circa(VFreq,60,0.04) then
            MONID = MONID'|MONID_VGA60'                 /* VGA60 */
         when Circa(VFreq,70,0.04) then
            MONID = MONID'|MONID_VGA70'                 /* VGA70 */
         otherwise
            MONID = MONID'|MONID_SPECIAL'
      end
   end
   when Circa(HFreq,38000,0.02) then                    /* 37000 kHz */
   do
      select
         when Circa(VFreq,50,0.04) then
            MONID = MONID'|MONID_SVGA50'                /* SVGA50 */
         when Circa(VFreq,60,0.04) then
            MONID = MONID'|MONID_SVGA60'                /* SVGA60 */
         when Circa(VFreq,70,0.04) then
            MONID = MONID'|MONID_SVGA70'                /* SVGA70 */
         otherwise
            MONID = MONID'|MONID_SPECIAL'
      end
   end
   otherwise
      MONID = MONID'|MONID_SPECIAL'                     /* Spezial */
end

/* Resolution Keys */
if Circa(Pixel,640,0.2) then
   MONID = MONID'|MONKEY_HIRES'                         /* Hires */
if Circa(AnzZeilen,512,0.2) then
   MONID = MONID'|MONKEY_HILINES'                       /* Hilines */
if Circa(Pixel/AnzZeilen,4/3,0.1) then
   MONID = MONID'|MONKEY_RATIO11'                       /* Ratio 1:1 */
/* Interlace, Doublescan */
select
   when upper(Flags) = 'I' then
      MONID = MONID'|MONKEY_LACE'
   when upper(Flags) = 'D' then
      MONID = MONID'|MONKEY_DBL'
   otherwise
      MONID = MONID
end
/* Resolution Flags */
select
   when Circa(Pixel,724,0.01) & Circa(AnzZeilen,566,0.01) then
      MONID = MONID'|MONRES_AMIGA'
   when Circa(Pixel,640,0.01) & Circa(AnzZeilen,480,0.01) then
      MONID = MONID'|MONRES_VGA'
   when Circa(Pixel,800,0.01) & Circa(AnzZeilen,600,0.01) then
      MONID = MONID'|MONRES_SVGA'
   when Circa(Pixel,1024,0.01) & Circa(AnzZeilen,768,0.01) then
      MONID = MONID'|MONRES_VGA2'
   when Circa(Pixel,1280,0.01) & Circa(AnzZeilen,1024,0.01) then
      MONID = MONID'|MONRES_VGA3'
   otherwise
      MONID = MONID
end
return

GetMonitorFlags:                                        /* MonitorFlags erzeugen */
MONFlags = ''
select
   when upper(Flags) = 'I' then
   do                                                   /* Lace */
      MONFlags = 'MDF_LACE'
      if upper(Modi) = 'P' then
         MONFlags = MONFlags'|MDF_PLANAR'               /* Planar Modi */
      if CLKFlag ~= '' then
         MONFlags = MONFlags'|MDF_CLKDIV2'              /* Pixeltakt /2 */
   end
   when upper(Flags) = 'D' then
   do                                                   /* DoubleScan */
      MONFlags = 'MDF_DBL'
      if upper(Modi) = 'P' then
         MONFlags = MONFlags'|MDF_PLANAR'               /* Planar Modi */
      if CLKFlag ~= '' then
         MONFlags = MONFlags'|MDF_CLKDIV2'              /* Pixeltakt /2 */
   end
   otherwise
      if CLKFlag ~= '' then
      do
         MONFlags = MONFlags'MDF_CLKDIV2'               /* Pixeltakt /2 */
      if upper(Modi) = 'P' then
         MONFlags = MONFlags'|MDF_PLANAR'               /* Planar Modi */
      end
      else do
      if upper(Modi) = 'P' then
         MONFlags = MONFlags'MDF_PLANAR'               /* Planar Modi */
      else
         MONFlags = '0'
      end
end
return