Topspeed_JPI/TS-V3/MODBASE/SMARTSCR.LST

Listing:

    1  IMPLEMENTATION MODULE SmartScreen;
    2  (*
    3   *  REPERTOIRE
    4   *  Release 1.6
    5   *  By Charles Bradford and Cole Brecheen
    6   *  (c) Copyright 1985-1992 PMI
    7   *  Green Bay, Wisconsin
    8   *  All rights reserved
    9   *  (414) 468-6040
   10   *
   11   *  $Header:   D:/logfiles/mods/smartscr.mov   1.5   17 Mar 1991 17:53:50   coleb  $
   12   *
   13   *)
   14  
   15  
   16  (*EntryDiag:
   17  IMPORT Diagnostics;
   18  :EntryDiag*)
   19  
   20  (* IMPORT EnvironUtils; *)
   21  IMPORT ErrorManager;
   22  IMPORT LowLevel;
   23  IMPORT M2Strings;
   24  IMPORT Numbers;
   25  IMPORT StrConv;
   26  IMPORT StrEdit;
   27  IMPORT StringIO;
   28  IMPORT SYSTEM;
   29  IMPORT VStorage;
   30  IMPORT FAPI;
   31  
   32  
   33  VAR
   34    Initialized : BOOLEAN;
   35  
   36  
   37    CONST
   38      blink = 16;
   39      byte1 = 0;
   40    VAR
   41      ReturnCode: CARDINAL;
   42      TextAttrByte: CHAR;
   43      NoSnow, UsingColor: BOOLEAN;
   44      NilValue : VStorage.MemHandle;
*****                          ^ not supported yet
   45      setting : ARRAY [0..80] OF CHAR;
*****                          ^ not supported yet
*****                                 ^ not supported yet
   46  
   47  
   48    PROCEDURE SetBits( VAR TheWord: SYSTEM.BYTE; bit1, bit2, bit3: CARDINAL );
*****                                           ^ not supported yet
   49      BEGIN
   50      END SetBits;
*****          ^ not supported yet
   51  
   52  
   53    PROCEDURE EndCol(): CARDINAL;
   54      VAR
   55        ModeData: FAPI.VIOMODEINFO;
*****                       ^ not supported yet
   56        ErrorNum: CARDINAL;
   57      BEGIN
   58  
   59        ModeData.cb := SYSTEM.TSIZE(FAPI.VIOMODEINFO);
*****        ^ not supported yet
*****                 ^ not supported yet
*****                       ^ not supported yet
*****                              ^ not supported yet
*****                                    ^ not supported yet
*****                                         ^ not supported yet
   60        ErrorNum := FAPI.VIOGETMODE(SYSTEM.ADR(ModeData), 0);
*****                    ^ not supported yet
*****                         ^ not supported yet
*****                                    ^ not supported yet
*****                                           ^ not supported yet
*****                                               ^ not supported yet
*****                                                           ^ not supported yet
   61        IF ErrorNum # 0 THEN
   62          ErrorManager.WarnNumber("VioGetMode error", ErrorNum);
*****          ^ not supported yet
*****                       ^ not supported yet
*****                                  ^ not supported yet
*****                                                              ^ not supported yet
   63        END;
   64        MaxCol := ModeData.col;
*****        ^ undeclared identifier
*****                  ^ not supported yet
*****                           ^ not supported yet
   65  (*
   66  MaxCol := 80;
   67  *)
   68        RETURN MaxCol;
*****               ^ undeclared identifier
   69      END EndCol;
*****          ^ not supported yet
   70  
   71  
   72    PROCEDURE EndRow(): CARDINAL;
   73      VAR
   74        ModeData: FAPI.VIOMODEINFO;
*****                       ^ not supported yet
   75        ErrorNum: CARDINAL;
   76      BEGIN
   77  
   78        ModeData.cb := SYSTEM.TSIZE(FAPI.VIOMODEINFO);
*****        ^ not supported yet
*****                 ^ not supported yet
*****                       ^ not supported yet
*****                              ^ not supported yet
*****                                    ^ not supported yet
*****                                         ^ not supported yet
   79        ErrorNum := FAPI.VIOGETMODE(SYSTEM.ADR(ModeData), 0);
*****                    ^ not supported yet
*****                         ^ not supported yet
*****                                    ^ not supported yet
*****                                           ^ not supported yet
*****                                               ^ not supported yet
*****                                                           ^ not supported yet
   80        IF ErrorNum # 0 THEN
   81          ErrorManager.WarnNumber("VioGetMode error", ErrorNum);
*****          ^ not supported yet
*****                       ^ not supported yet
*****                                  ^ not supported yet
*****                                                              ^ not supported yet
   82        END;
   83        MaxRow := ModeData.row;
*****        ^ undeclared identifier
*****                  ^ not supported yet
*****                           ^ not supported yet
   84  (*
   85  MaxRow := 25;
   86  *)
   87        RETURN MaxRow;
*****               ^ undeclared identifier
   88      END EndRow;
*****          ^ not supported yet
   89  
   90  
   91    PROCEDURE GotoXY(column, row : CARDINAL);
   92      (*puts cursor at column X, row Y *)
   93      VAR
   94        dumstr, dumstr2 : ARRAY [0..20] OF CHAR;
*****                                    ^ not supported yet
*****                                           ^ not supported yet
   95      BEGIN
   96        IF row>MaxRow THEN
*****               ^ undeclared identifier
   97          row := MaxRow - 1;
*****                 ^ undeclared identifier
   98        ELSIF row>0 THEN
   99          DEC(row);
*****          ^ undeclared identifier
*****                 ^ not supported yet
  100        END;
  101        IF column>MaxCol THEN
*****                  ^ undeclared identifier
  102          column := MaxCol - 1;
*****                    ^ undeclared identifier
  103        ELSIF column>0 THEN
  104          DEC(column);
*****          ^ undeclared identifier
*****                    ^ not supported yet
  105        END;
  106        IF FAPI.VIOSETCURPOS(row, column, 0) # 0 THEN
*****           ^ not supported yet
*****                ^ not supported yet
*****                                           ^ not supported yet
  107          ErrorManager.WARN("VioSetCurPos error ");
*****          ^ not supported yet
*****                       ^ not supported yet
*****                            ^ not supported yet
  108        END;
  109      END GotoXY;
*****          ^ not supported yet
  110  
  111  
  112    PROCEDURE MonoAttrsToColor(AttrSet : AttributeSet; VAR fg, bg :
*****                                         ^ undeclared identifier
  113          Colors);
*****          ^ undeclared identifier
  114      BEGIN
  115        fg := ForeGround;
*****        ^ not supported yet
*****              ^ undeclared identifier
  116        bg := BackGround;
*****        ^ not supported yet
*****              ^ undeclared identifier
  117        IF invisible IN AttrSet THEN
*****           ^ undeclared identifier
*****                        ^ not supported yet
  118          fg := black;
*****          ^ not supported yet
*****                ^ undeclared identifier
  119          bg := black;
*****          ^ not supported yet
*****                ^ undeclared identifier
  120          RETURN;
  121        END;
  122        IF plain IN AttrSet THEN
*****           ^ undeclared identifier
*****                    ^ not supported yet
  123          fg := lightgrey;
*****          ^ not supported yet
*****                ^ undeclared identifier
  124          bg := black;
*****          ^ not supported yet
*****                ^ undeclared identifier
  125          RETURN;
  126        END;
  127        IF underscored IN AttrSet THEN
*****           ^ undeclared identifier
*****                          ^ not supported yet
  128          fg := blue;
*****          ^ not supported yet
*****                ^ undeclared identifier
  129          bg := black;
*****          ^ not supported yet
*****                ^ undeclared identifier
  130        END;
  131        IF ReverseVideo IN AttrSet THEN
*****           ^ undeclared identifier
*****                           ^ not supported yet
  132          fg := black;
*****          ^ not supported yet
*****                ^ undeclared identifier
  133          bg := lightgrey;
*****          ^ not supported yet
*****                ^ undeclared identifier
  134        END;
  135        IF (bold IN AttrSet) AND (ForeGround<darkgrey) THEN
*****            ^ undeclared identifier
*****                    ^ not supported yet
*****                                  ^ undeclared identifier
*****                                             ^ undeclared identifier
  136          fg := VAL(Colors, ORD(ForeGround)+ORD(darkgrey));
*****          ^ not supported yet
*****                ^ undeclared identifier
*****                    ^ undeclared identifier
*****                            ^ undeclared identifier
*****                                ^ undeclared identifier
*****                                            ^ undeclared identifier
*****                                                ^ undeclared identifier
  137        END;
  138        IF (blinking IN AttrSet) AND (ORD(BackGround)<(blink DIV 2)) THEN
*****            ^ undeclared identifier
*****                        ^ not supported yet
*****                                      ^ undeclared identifier
*****                                          ^ undeclared identifier
  139          bg := VAL(Colors, ORD(BackGround)+(blink DIV 2));
*****          ^ not supported yet
*****                ^ undeclared identifier
*****                    ^ undeclared identifier
*****                            ^ undeclared identifier
*****                                ^ undeclared identifier
*****                                                         ^ not supported yet
  140        END;
  141      END MonoAttrsToColor;
*****          ^ not supported yet
  142  
  143    PROCEDURE ColorToMonoAttrs(fg, bg : Colors; VAR AttrSet :
*****                                        ^ undeclared identifier
  144          AttributeSet);
*****          ^ undeclared identifier
  145      BEGIN
  146        AttrSet := AttributeSet{plain};
*****        ^ not supported yet
*****                   ^ undeclared identifier
  147        IF (ORD(bg)>=(blink DIV 2)) THEN
  148          AttrSet := AttributeSet{blinking};
  149          bg := VAL(Colors, ORD(bg)-(blink DIV 2));
  150        END;
  151        IF fg>=darkgrey THEN
  152          INCL(AttrSet, bold);
  153          fg := VAL(Colors, ORD(fg)-ORD(darkgrey));
  154        END;
  155        CASE bg OF
  156          black :
  157          IF fg=blue THEN
  158            INCL(AttrSet, underscored);
  159          ELSIF fg=black THEN
  160            AttrSet := AttributeSet{invisible};
  161          END;
  162        | lightgrey :
  163          IF fg=black THEN
  164            INCL(AttrSet, ReverseVideo);
  165          END;
  166        ELSE
  167        END;
  168        IF AttrSet#AttributeSet{plain} THEN
  169          EXCL(AttrSet, plain);
  170        END;
  171      END ColorToMonoAttrs;
  172  
  173    PROCEDURE MakeAttrByte();
  174      VAR
  175        cnt: CARDINAL;
  176      BEGIN
  177        cnt := ORD(BackGround);
  178        LowLevel.ShiftLeft(cnt, 4);
  179        TextAttrByte := CHR(ORD(ForeGround)+cnt);
  180      END MakeAttrByte;
  181  
  182  
  183  
  184    PROCEDURE TextColor(fg, bg : Colors);
  185      VAR
  186        dumstr : ARRAY [0..8] OF CHAR;
  187      BEGIN
  188        ForeGround := fg;
  189        BackGround := bg;
  190        ColorToMonoAttrs(fg, bg, TextModeNow);
  191        MakeAttrByte();
  192      END TextColor;
  193  
  194    PROCEDURE ReverseColors();
  195      (* Switches fore and back ground colors, like reverse video *)
  196      VAR
  197        SwitchColor : Colors;
  198      BEGIN
  199        SwitchColor := ForeGround;
  200        ForeGround := BackGround;
  201        BackGround := SwitchColor;
  202        MakeAttrByte();
  203      END ReverseColors;
  204  
  205    PROCEDURE SetAttribOrColor(forec, backc: Colors; atrib: TextAttribute);
  206    (* depending on current screen mode, sets color or mono attribute *)
  207      BEGIN
  208        IF UsingColor THEN
  209          IF (forec<>ForeGround) OR (backc<>BackGround) THEN
  210            TextColor( forec, backc);
  211          END;
  212        ELSE
  213          IF NOT (atrib IN TextModeNow) THEN
  214            TextModeNow := AttributeSet{};
  215            ForeGround := lightgrey;
  216            BackGround := black;
  217            IF VideoMethod=ANSI THEN
  218              TextMode( plain);  (* resets to plain first *)
  219              TextMode( atrib);
  220            ELSE
  221              INCL(TextModeNow, atrib);
  222              MonoAttrsToColor(TextModeNow, ForeGround, BackGround);
  223              MakeAttrByte();
  224            END;
  225          END;
  226        END;
  227      END SetAttribOrColor;
  228  
  229  
  230    PROCEDURE TextMode(attribute : TextAttribute);
  231  
  232      PROCEDURE UpdateNeeded(attribute : TextAttribute) : BOOLEAN;
  233        VAR
  234          answer : BOOLEAN;
  235        BEGIN
  236          answer := FALSE;
  237          IF attribute=plain THEN
  238            IF TextModeNow#AttributeSet{plain} THEN
  239              answer := TRUE;
  240            END;
  241            TextModeNow := AttributeSet{plain};
  242          ELSIF NOT (attribute IN TextModeNow) THEN
  243            INCL(TextModeNow, attribute);
  244            EXCL(TextModeNow, plain);
  245            RETURN (TRUE);
  246          END;
  247          RETURN (answer);
  248        END UpdateNeeded;
  249  
  250      VAR
  251        fground, bground : CARDINAL;
  252      BEGIN
  253        IF UpdateNeeded(attribute) THEN
  254          MonoAttrsToColor(TextModeNow, ForeGround, BackGround);
  255          MakeAttrByte();
  256        END;
  257      END TextMode;
  258  
  259  
  260    PROCEDURE ScreenMode(TheMode : ScreenModeType);
  261      VAR
  262  
  263        dumstr : ARRAY [0..8] OF CHAR;
  264        temp, ModeData: FAPI.VIOMODEINFO;
  265      BEGIN
  266  
  267        IF TheMode # ScreenModeNow THEN
  268          CASE TheMode OF
  269  
  270            BW40x25:
  271              (* BIOS MODE 0 *)
  272            ModeData.cb := 12;
  273            ModeData.fbType := FAPI.UCHAR(FAPI.VGMT_DISABLEBURST);
  274                (* mono *)
  275            ModeData.hres := 320;
  276            ModeData.vres  := 200;
  277            ModeData.row := 25;
  278            ModeData.col := 40;
  279            SetBits (ModeData.color, 0, 7, 1);
  280              (* 2 colors = B/w ???*)
  281  
  282          | color40x25:
  283              (* BIOS MODE 1 *)
  284            ModeData.cb := 12;
  285            ModeData.row :=25 ;
  286            ModeData.col := 40;
  287            ModeData.fbType := FAPI.VGMT_OTHER;
  288                (* color ??? *)
  289            ModeData.hres := 320;
  290            ModeData.vres  := 200;
  291            SetBits (ModeData.color, 0, 7, 4);
  292              (* 16 colors *)
  293  
  294          | BW80x25:
  295              (* BIOS MODE 2 *)
  296            ModeData.cb := 12;
  297            ModeData.row := 25;
  298            ModeData.col := 80;
  299            ModeData.fbType := FAPI.VGMT_DISABLEBURST;
  300            ModeData.hres := 640;
  301            ModeData.vres  := 200;
  302            SetBits (ModeData.color, 0, 7, 1);
  303              (* 2 colors = B/w ???*)
  304  
  305          | color80x25:
  306              (* BIOS MODE 3 *)
  307            ModeData.cb := 12;
  308            ModeData.row :=25 ;
  309            ModeData.col :=80 ;
  310            ModeData.fbType := FAPI.VGMT_OTHER;
  311              (* ModeData.color *)
  312            ModeData.hres := 640;
  313            ModeData.vres  := 200;
  314            SetBits (ModeData.color, 0, 7, 4);
  315              (* 16 colors *)
  316  
  317          | color320:
  318              (* BIOS MODE 4 *)
  319            ModeData.cb := 12;
  320            ModeData.row := 0 ;
  321            ModeData.col := 0 ;
  322            ModeData.fbType := FAPI.VGMT_GRAPHICS;
  323              (* color graphics *)
  324            ModeData.hres := 320;
  325            ModeData.vres  := 200;
  326            SetBits (ModeData.color, 0, 7, 2);
  327              (* 4 colors *)
  328  
  329          | BW320:
  330              (* BIOS MODE 5 *)
  331            ModeData.cb := 12;
  332            ModeData.row := 0;
  333            ModeData.col :=0 ;
  334            ModeData.fbType := FAPI.VGMT_DISABLEBURST + FAPI.VGMT_GRAPHICS;
  335            ModeData.hres := 320;
  336            ModeData.vres  := 200;
  337            SetBits (ModeData.color, 0, 7, 1);
  338              (* 2 colors = B/w ???*)
  339  
  340          | BW640:
  341              (* BIOS MODE 6 *)
  342            ModeData.cb := 12;
  343            ModeData.row := 0;
  344            ModeData.col :=0 ;
  345            ModeData.fbType := FAPI.VGMT_DISABLEBURST + FAPI.VGMT_GRAPHICS;
  346            ModeData.hres := 640;
  347            ModeData.vres  := 200;
  348            SetBits (ModeData.color, 0, 7, 1);
  349              (* 2 colors = B/w ???*)
  350  
  351          | Mono:
  352              (* BIOS MODE 7 *)
  353            ModeData.row := 25;
  354            ModeData.cb := 12;
  355            ModeData.col :=80 ;
  356            ModeData.fbType := FAPI.VGMT_DISABLEBURST;
  357              (* mono *)
  358            ModeData.hres := 720;
  359            ModeData.vres  := 350;
  360            SetBits (ModeData.color, 0, 7, 1);
  361              (* 2 colors = B/w ???*)
  362  
  363          | PCjr160:
  364              (*   BIOS MODE 8 not supported *)
  365            ErrorManager.WARN("VioSetMode - not supported ");
  366  
  367          | PCjr320:
  368              (* BIOS MODE 9 - NOT SUPPORTED *)
  369            ErrorManager.WARN("VioSetMode - not supported ");
  370  
  371          | PCjr640:
  372              (* BIOS MODE Ah - NOT SUPPORTS *)
  373            ErrorManager.WARN("VioSetMode - not supported ");
  374  
  375          | EGA11:
  376              (* BIOS MODE B hex - not supported *)
  377            ErrorManager.WARN("VioSetMode - not supported ");
  378  
  379          | EGA12:
  380              (* BIOS MODE c hex  *);
  381  
  382          | EGA320:
  383              (* BIOS MODE d hex *)
  384            ModeData.cb := 12;
  385            ModeData.row := 0;
  386            ModeData.col := 0;
  387            ModeData.fbType := FAPI.VGMT_GRAPHICS + FAPI.VGMT_OTHER;
  388               (*??*)
  389            ModeData.hres := 320;
  390            ModeData.vres  := 200;
  391            SetBits (ModeData.color, 0, 7, 4);
  392              (* 16 colors *)
  393  
  394          | EGA640:
  395              (* BIOS MODE E hex *)
  396            ModeData.cb := 12;
  397            ModeData.row := 0;
  398            ModeData.col :=0 ;
  399            ModeData.fbType := FAPI.VGMT_GRAPHICS + FAPI.VGMT_OTHER;
  400            ModeData.hres := 640;
  401            ModeData.vres  := 200;
  402            SetBits (ModeData.color, 0, 7, 2);
  403              (* 4 colors = *)
  404  
  405          | EGAMono:
  406              (* BIOS MODE F hex *)
  407            ModeData.cb := 12;
  408            ModeData.row := 0;
  409            ModeData.col :=0 ;
  410            ModeData.fbType := FAPI.VGMT_GRAPHICS;
  411            ModeData.hres := 640;
  412            ModeData.vres  := 350;
  413            SetBits (ModeData.color, 0, 7, 1);
  414              (* 2 colors = B/w ???*)
  415  
  416          | EGA64color:
  417              (* BIOS MODE 10 hex *)
  418            ModeData.cb := 12;
  419            ModeData.row := 0;
  420            ModeData.col :=0 ;
  421            ModeData.fbType := FAPI.VGMT_GRAPHICS + FAPI.VGMT_OTHER;
  422            ModeData.hres := 640;
  423            ModeData.vres  := 350;
  424            SetBits (ModeData.color, 0, 7, 4);
  425              (* 16  colors *)
  426  
  427          ELSE
  428            ErrorManager.WARN ("Screen mode not supported");
  429          END; (* CASE *)
  430  
  431          ModeData.cb := SYSTEM.TSIZE(FAPI.VIOMODEINFO);
  432          IF FAPI.VIOSETMODE(SYSTEM.ADR(ModeData), 0) #0 THEN
  433            ErrorManager.WARN("VioSetMode error");
  434          END;
  435  
  436          MaxCol := ModeData.col;
  437          MaxRow := ModeData.row;
  438          ScreenModeNow := TheMode;
  439          UsingColor := NOT ( (TheMode = BW40x25) OR (TheMode = BW80x25)
  440                        OR (TheMode = BW320) OR (TheMode = BW640) OR
  441                        (TheMode = Mono) OR (TheMode = EGAMono));
  442        END;
  443  
  444      END ScreenMode;
  445  
  446  
  447    PROCEDURE coord(ColNum, RowNum : CARDINAL) : CARDINAL;
  448    (*Makes it easier to work with the routines below, which
  449      treat the screen as a linear sequence OF 4000 bytes.*)
  450      BEGIN
  451        RETURN (Numbers.Between(0, RowNum-1, MaxRow-1) * MaxCol +
  452            Numbers.Between(1, ColNum, MaxCol));
  453      END coord;
  454  
  455  
  456    PROCEDURE RealVideoMode() : ScreenModeType;
  457      (* This is incomplete, I know, but its only purpose is
  458         compatibility with old code.  New code ought
  459         to get this information in some more rational way. *)
  460      VAR
  461        ModeData: FAPI.VIOMODEINFO;
  462        ErrorNum: CARDINAL;
  463      BEGIN
  464        ModeData.cb := SYSTEM.TSIZE(FAPI.VIOMODEINFO);
  465  
  466        ErrorNum := FAPI.VIOGETMODE(SYSTEM.ADR(ModeData), 0);
  467  
  468        IF ErrorNum # 0 THEN
  469          ErrorManager.WarnNumber("VioGetMode Error", ErrorNum);
  470        END;
  471        MaxCol := ModeData.col;
  472        MaxRow := ModeData.row +1;
  473          (* Adjust to Repertoire's system of
  474             numbering from 1 instead of 0 *)
  475        IF (CARDINAL(LowLevel.BitwiseAnd(FAPI.VGMT_OTHER,
  476                                ORD(ModeData.fbType))) # 0) THEN
  477          IF (CARDINAL(LowLevel.BitwiseAnd(FAPI.VGMT_GRAPHICS,
  478                                           ORD(ModeData.fbType))) # 0) THEN
  479            (* We're in a graphics mode. *)
  480            IF CARDINAL(LowLevel.BitwiseAnd(FAPI.VGMT_DISABLEBURST,
  481                  ORD(ModeData.fbType))) # 0 THEN
  482              (* We're in a monochrome graphics mode. *)
  483              IF ModeData.hres = 320 THEN
  484                RETURN BW320;
  485              ELSE
  486                RETURN BW640;
  487              END;
  488            ELSE
  489              (* We're in a color graphics mode. *)
  490              IF ModeData.hres = 320 THEN
  491                RETURN EGA320;
  492              ELSE
  493                RETURN EGA640;
  494              END;
  495            END;
  496          ELSE
  497            (* We're in a text mode. *)
  498            IF CARDINAL(LowLevel.BitwiseAnd(FAPI.VGMT_DISABLEBURST,
  499                                            ORD(ModeData.fbType))) # 0 THEN
  500              (* We're in a monochrome text mode. *)
  501              IF (ModeData.row =25) AND (ModeData.col = 40) THEN
  502                RETURN BW40x25;
  503              ELSE
  504                RETURN BW80x25;
  505              END;
  506            ELSE
  507              (* We're in a color text mode. *)
  508              IF (ModeData.row =25) AND (ModeData.col = 40) THEN
  509                RETURN color40x25;
  510              ELSE
  511                RETURN color80x25;
  512              END;
  513            END;
  514      END;
  515        ELSE
  516          RETURN Mono;
  517        END;
  518  
  519        RETURN color80x25;
  520      END RealVideoMode;
  521  
  522  
  523    PROCEDURE WriteAt(ColNum, RowNum : CARDINAL; TheStr : ARRAY OF CHAR);
  524      BEGIN
  525        AdrWriteAt( ColNum, RowNum, SYSTEM.ADR(TheStr),
  526            M2Strings.Length(TheStr));
  527      END WriteAt;
  528  
  529  
  530    PROCEDURE AdrWriteAt(ColNum, RowNum : CARDINAL; TheAdr:
  531        SYSTEM.ADDRESS; TheSize: CARDINAL );
  532      BEGIN
  533        IF TheSize = 0 THEN
  534          RETURN;
  535        END;
  536        ColNum := Numbers.Between( 1, ColNum, MaxCol );
  537        RowNum := Numbers.Between( 1, RowNum, MaxRow );
  538        TheSize := Numbers.Min( TheSize, (MaxCol - ColNum) + 1 );
  539        NominalCol := ColNum + TheSize;
  540        NominalRow := RowNum;
  541        IF FAPI.VIOWRTCHARSTRATT( TheAdr, TheSize,
  542            RowNum-1, ColNum-1, SYSTEM.ADR(TextAttrByte), 0 ) # 0 THEN
  543          ErrorManager.WARN("VioWrtCharStrAtt error");
  544        END;
  545      END AdrWriteAt;
  546  
  547  
  548    PROCEDURE SetCursorHeight(lines : CARDINAL);
  549      VAR
  550        CursorData: FAPI.VIOCURSORINFO;
  551      BEGIN
  552        ReturnCode := FAPI.VIOGETCURTYPE(SYSTEM.ADR(CursorData), 0);
  553        IF ReturnCode # 0 THEN
  554          ErrorManager.WarnNumber("VioGetCurType error", ReturnCode);
  555        END;
  556          (* We set CursorWidth to 0, which means default width, because
  557             the API.LIB version of VIOGETCURTYPE doesn't seem to be
  558             returning values that can be passed on to VIOSETCURTYPE. *)
  559        CursorData.cx := 0;
  560  (*
  561        CursorData.CursorEndLine := -100;
  562             OS/2 lets us specify percentages of the character cell by
  563             using negative numbers.  This means that the end line is
  564             always 100% of the way down from the top of the character
  565             cell.
  566  
  567  Unfortunately, API.LIB doesn't support this, so we start by getting
  568  CursorData, and we try not to change it much.
  569  *)
  570        IF lines <= 0 THEN
  571          CursorData.attr := 65535;
  572        ELSE
  573          CursorData.attr := 1;
  574          IF lines >= 10 THEN
  575            CursorData.yStart := 0;
  576          ELSE
  577            CursorData.yStart := CursorData.cEnd - lines;
  578          END;
  579        END;
  580        ReturnCode := FAPI.VIOSETCURTYPE(SYSTEM.ADR(CursorData), 0);
  581        IF ReturnCode # 0 THEN
  582          ErrorManager.WarnNumber("VioSetCurType error", ReturnCode);
  583        END;
  584      END SetCursorHeight;
  585  
  586  
  587    PROCEDURE ClearPart(col1, row1, col2, row2 : CARDINAL);
  588      VAR
  589        BackGroundCell: VideoMemChar;
  590      BEGIN
  591        row2 := Numbers.Min( row2, MaxRow );
  592        col2 := Numbers.Min( col2, MaxCol );
  593        col1 := Numbers.Between( 1, col1, col2 );
  594        row1 := Numbers.Between( 1, row1, row2 );
  595        BackGroundCell.attr :=TextAttrByte;
  596        BackGroundCell.ch := ' ';
  597        IF FAPI.VIOSCROLLUP( row1-1, col1-1, row2-1, col2-1, 65535,
  598            SYSTEM.ADR(BackGroundCell), 0) # 0 THEN
  599          ErrorManager.WARN("VioScrollUp error");
  600        END;
  601      END ClearPart;
  602  
  603  
  604    PROCEDURE ClearScreen();
  605    (*Clears the screen and sends the cursor to the top left corner.*)
  606      BEGIN
  607        ClearPart(1, 1, MaxCol, MaxRow);
  608      END ClearScreen;
  609  
  610  
  611    PROCEDURE SetVideoVars();
  612      BEGIN
  613        ScreenModeNow := RealVideoMode();
  614        IF ScreenModeNow >= color320 THEN
  615          VideoMethod := ROM;
  616        END;
  617        IF M2Strings.CompareStr( setting, 'DMAWAIT') = 0 THEN
  618          NoSnow := TRUE;
  619        ELSIF M2Strings.CompareStr( setting, 'DMA') = 0 THEN
  620          NoSnow := FALSE;
  621        ELSE
  622          NoSnow := ScreenModeNow < Mono;
  623        END;
  624        UsingColor := NOT ( (ScreenModeNow = BW40x25) OR
  625                            (ScreenModeNow = BW80x25) OR
  626                            (ScreenModeNow = BW320) OR
  627                            (ScreenModeNow = BW640) OR
  628                            (ScreenModeNow = Mono) OR
  629                            (ScreenModeNow = EGAMono));
  630      END SetVideoVars;
  631  
  632  
  633  
  634    PROCEDURE SetVideoMethod( NewMethod: VidMethodType);
  635      BEGIN
  636        IF (VideoMethod = ANSI) AND (NewMethod # ANSI) THEN
  637          SetVideoVars();
  638        END;
  639        VideoMethod := NewMethod;
  640      END SetVideoMethod;
  641  
  642  
  643    PROCEDURE Init();
  644      BEGIN
  645        IF Initialized THEN
  646          RETURN;
  647        ELSE
  648          Initialized := TRUE;
  649        END;
  650  (*EntryDiag:
  651        Diagnostics.Init();
  652  :EntryDiag*)
  653  
  654        ErrorManager.Init();
  655        LowLevel.Init();
  656        M2Strings.Init();
  657        Numbers.Init();
  658        StrConv.Init();
  659        StrEdit.Init();
  660        StringIO.Init();
  661        VStorage.Init();
  662  (*EntryDiag:
  663        Diagnostics.diagS( 'Entering SmartScreen', '' );
  664  :EntryDiag*)
  665  
  666        VStorage.NilHandle( NilValue );
  667        VideoMethod := DMA;
  668        ForeGround := lightgrey;
  669        BackGround := black;
  670        TextModeNow := AttributeSet{ plain};
  671        MakeAttrByte();
  672        MaxCol := 80;
  673        MaxRow := 25;
  674  
  675  (*
  676        ScreenModeNow :=RealVideoMode();
  677  *)
  678        SetVideoVars();
  679  
  680  (*EntryDiag:
  681        Diagnostics.diagS( 'Exiting SmartScreen', '' );
  682  :EntryDiag*)
  683      END Init;
  684  
  685  BEGIN
  686    Initialized := FALSE;
  687    Init();
  688  END SmartScreen.

  122 errors