_STRUCTURED PROGRAMMING COLUMN_
by Jeff Duntemann

[LISTING ONE]

{ Calendar unit demo program }
{ Jeff Duntemann  -- 2/3/89  }


PROGRAM CalTest;


USES DOS,Crt,    { Standard Borland units }
     Screens,    { Given in DDJ 4/89 }
     Calendar;   { Given in DDJ 6/89 }

CONST
  YellowOnBlue = $1E; { Text attribute; yellow chars on blue background }
  CalX         = 25;
  CalY         = 5;


VAR
  MyScreen   : ScreenPtr;  { Type exported by Screens unit }
  WorkScreen : Screen;     { Type exported by Screens unit }
  Ch         : Char;
  Quit       : Boolean;
  ShowFor    : DateTime;   { Type exported by DOS unit }
  I          : Word;       { Dummy; picks up dayofweek field in GetDate }


BEGIN
  MyScreen := @WorkScreen;    { Create a pointer to WorkScreen }
  InitScreen(MyScreen,True);
  ClrScreen(MyScreen,ClearAtom);     { Clear the entire screen }
  Quit := False;

  WITH ShowFor DO    { Start with clock date }
    GetDate(Year,Month,Day,I);

  ShowCalendar(MyScreen,ShowFor,CalX,CalY,YellowOnBlue);

  REPEAT                    { Until Enter is pressed: }
    IF Keypressed THEN      { If a keystroke is detected }
      BEGIN
        Ch := ReadKey;      { Pick up the keystroke }
        IF Ord(Ch) = 0 THEN { See if it's an extended keystroke }
          BEGIN
            Ch := ReadKey;  { If so, pick up scan code }
            CASE Ord(Ch) OF { and parse it }
              72 : Pan(MyScreen,Up,1);   { Up arrow }
              80 : Pan(MyScreen,Down,1); { Down arrow }
              75 : BEGIN                 { Left arrow; "down time" }
                     WITH ShowFor DO
                       IF Month = 1 THEN
                         BEGIN
                           Month := 12;
                           Dec(Year)
                         END
                       ELSE Dec(Month);
                     ShowCalendar(MyScreen,ShowFor,CalX,CalY,YellowOnBlue);
                   END;
              77 : BEGIN                 { Right arrow; "up time" }
                     WITH ShowFor DO
                       IF Month = 12 THEN
                         BEGIN
                           Month := 1;
                           Inc(Year)
                         END
                       ELSE Inc(Month);
                     ShowCalendar(MyScreen,ShowFor,CalX,CalY,YellowOnBlue);
                   END;
            END { CASE }
          END
        ELSE     { If it's an ordinary keystroke, test for quit: }
          IF Ch = Chr(13) THEN Quit := True
      END;
  UNTIL Quit;
  ClrScreen(MyScreen,ClearAtom)  { All this stuff's exported by Screens }
END.


[LISTING TWO]

{--------------------------------------------------------------}
{                         CALENDAR                             }
{                                                              }
{          Text calendar for virtual screen platform           }
{                                                              }
{                                    by Jeff Duntemann KI6RA   }
{                                    Turbo Pascal 5.0          }
{                                    Last modified 2/3/89      }
{--------------------------------------------------------------}

UNIT Calendar;

INTERFACE

USES DOS,       { Standard Borland unit }
     TextInfo,  { Given in DDJ 3/89     }
     Screens,   { Given in DDJ 4/89     }
     CalCalc;   { Given in DDJ 6/89 courtesy Michael Covington }

TYPE
  DaysOfWeek = (Sunday,Monday,Tuesday,Wednesday,Thursday,Friday,Saturday);
  Months     = (January,February,March,April,May,June,July,
                August,September,October,November,December);


PROCEDURE ShowCalendar(Target    : ScreenPtr;
                       ShowFor   : DateTime;
                       CalX,CalY : Integer;
                       Attribute : Byte);


IMPLEMENTATION

TYPE
  String10 = STRING[10];

CONST
  MonthNames : ARRAY[January..December] OF String10 =
  ('January','February', 'March','April','May','June','July',
   'August', 'September','October','November','December');
  Days : ARRAY[January..December] OF Integer =
  (31,28,31,30,31,30,31,31,30,31,30,31);

{$L CALBLKS}
{$F+} PROCEDURE CalFrame; EXTERNAL;
      PROCEDURE Caldata;  EXTERNAL;
{$F-}

{$L BLKBLAST}
{$F+}
PROCEDURE BlkBlast(ScreenEnd,StoreEnd : Pointer;
                   ScreenX,ScreenY    : Integer;
                   ULX,ULY            : Integer;
                   Width,Height       : Integer;
                   Attribute          : Byte;
                   DeadLines          : Integer;
                   TopStop            : Integer);
          EXTERNAL;
{$F-}



FUNCTION IsLeapYear(Year : Integer) : Boolean;

{ Works from 1901 - 2199 }

BEGIN
  IsLeapYear := False;
  IF (Year MOD 4) = 0 THEN IsLeapYear := True
END;




PROCEDURE FrameCalendar(Target    : ScreenPtr;
                        CalX,CalY : Integer;
                        Attribute : Byte;
                        StartDay  : DaysOfWeek;
                        DayCount  : Integer);

TYPE
  PointerMath = RECORD
                  CASE BOOLEAN OF
                    True  : (APointer : Pointer);
                    False : (OfsWord  : Word;
                             SegWord  : Word)
                END;

VAR
  DataPtr    : Pointer;
  FudgeIt    : PointerMath;
  DayInset   : Word;
  DayTopStop : Word;

BEGIN
  { DayInset allows is to specify which day of the week the first of the }
  { month falls.  It's an offset into the block containing day figures   }
  DayInset := (7-Ord(StartDay))*4;
  { DayTopStop allows us to specify how many days to show in the month.  }
  DayTopStop := 28+(DayCount*4)-DayInset;
  BlkBlast(Target,@CalFrame,    { Display the calendar frame            }
           VisibleX,VisibleY,   { Genned screen size from TextInfo unit }
           CalX,CalY,           { Show at specified coordinates         }
           29,17,               { Size of calendar frame block          }
           Attribute,           { Attribute to use for calendar frame   }
           0,                   { No interspersed empty lines           }
           0);                  { No topstop; show the whole thing.     }

  WITH FudgeIt DO { FudgeIt is a free union allowing pointer arithmetic }
    BEGIN
      APointer := @CalData;     { Create the pointer to the days block  }
      OfsWord  := OfsWord+DayInset; { Offset into block for start day   }

      BlkBlast(Target,APointer,     { Blast the day block over the      }
               VisibleX,VisibleY,   {   calendar frame }
               CalX+1,CalY+5,       { Pos. of days relative to frame    }
               28,6,                { Size of day block }
               Attribute,           { Show days in same color as frame  }
               1,                   { Insert 1 line between block lines }
               DayTopStop)          { Set limit on number of chars to   }
    END                             { be copied from block to control   }
END;                                { how many days shown for a month   }




PROCEDURE ShowCalendar(Target    : ScreenPtr;
                       ShowFor   : DateTime;
                       CalX,CalY : Integer;
                       Attribute : Byte);

CONST
  NameOffset : ARRAY[January..December] OF Integer =
  (8,8,10,10,11,10,10,9,7,8,8,8);

VAR
  StartDay    : DaysOfWeek;
  TargetMonth : Months;
  TargetDay   : Real;
  DaysInMonth : Integer;

BEGIN
  { First figure day number since 1980: }
  WITH ShowFor DO TargetDay := DayNumber(Year,Month,1);
  { Then use the day number to calculate day-of-the-week: }
  StartDay := DaysOfWeek(WeekDay(TargetDay)-1);
  TargetMonth := Months(ShowFor.Month-1);
  DaysInMonth := Days[TargetMonth];
  { Test and/or adjust for leap year: }
  IF TargetMonth = February THEN
    IF IsLeapYear(ShowFor.Year) THEN DaysInMonth := 29;
  { Now draw the frame on the virtual screen! }
  FrameCalendar(Target,
                CalX,CalY,
                Attribute,
                StartDay,
                DaysInMonth);
  { Add the month name and year atop the frame: }
  GotoXY(Target,CalX+NameOffset[TargetMonth],CalY+1);
  WriteTo(Target,MonthNames[TargetMonth]+' '+IntStr(ShowFor.Year,4));
END;



END.

[LISTING THREE]

UNIT CalCalc;

{ --- Calendrics --- }

{ Long-range calendrical package in standard Pascal  }
{ Copyright 1985 Michael A. Covington                }

INTERFACE

function daynumber(year,month,day:integer):real;

procedure caldate(date:real; var year,month,day:integer);

function weekday(date:real):integer;

function julian(date:real):real;

IMPLEMENTATION


function floor(x:real) : real;
  { Largest whole number not greater than x.           }
  { Uses real data type to accommodate large numbers.  }
begin
  if (x < 0) and (frac(x) <> 0) then
    floor := int(x) - 1.0
  else
    floor := int(x)
end;



function daynumber(year,month,day:integer):real;
  { Number of days elapsed since 1980 January 0 (1979 December 31). }
  { Note that the year should be given as (e.g.) 1985, not just 85. }
  { Switches from Julian to Gregorian calendar on Oct. 15, 1582.    }
var
  y,m:   integer;
  a,b,d: real;
begin
  if year < 0 then y := year + 1
              else y := year;
  m := month;
  if month < 3 then
    begin
      m := m + 12;
      y := y - 1
    end;
  d := floor(365.25*y) + int(30.6001*(m+1)) + day - 723244.0;
  if d < -145068.0 then
    { Julian calendar }
    daynumber := d
  else
    { Gregorian calendar }
    begin
      a := floor(y/100.0);
      b := 2 - a + floor(a/4.0);
      daynumber := d + b
    end
end;

procedure caldate(date:real; var year,month,day:integer);
  { Inverse of DAYNUMBER; given date, finds year, month, and day.   }
  { Uses real arithmetic because numbers are too big for integers.  }
var
  a,aa,b,c,d,e,z: real;
  y: integer;
begin
  z := int(date + 2444239.0);
  if date < -145078.0 then
    { Julian calendar }
    a := z
  else
    { Gregorian calendar }
    begin
      aa := floor((z-1867216.25)/36524.25);
      a := z + 1 + aa - floor(aa/4.0)
    end;
  b := a + 1524.0;
  c := int((b-122.1)/365.25);
  d := int(365.25*c);
  e := int((b-d)/30.6001);
  day := trunc(b - d - int(30.6001*e));
  if e > 13.5 then month := trunc(e - 13.0)
              else month := trunc(e - 1.0);
  if month > 2 then y := trunc(c - 4716.0)
               else y := trunc(c - 4715.0);
  if y < 1 then year := y - 1
           else year := y
end;

function weekday(date:real):integer;
  { Given day number as used in the above routines,   }
  { finds day of week (1 = Sunday, 2 = Monday, etc.). }
var
  dd: real;
begin
  dd := date;
  while dd > 28000.0 do dd:=dd-28000.0;
  while dd < 0 do dd:=dd+28000.0;
  weekday := ((trunc(dd) + 1) mod 7) + 1
end;

function julian(date:real):real;
  { Converts result of DAYNUMBER into a Julian date. }
begin
  julian := date + 2444238.5
end;

END.  { CalCalc }

[LISTING FOUR]

;===========================================================================
;
; B L K B L A S T  -  Blast 2D character pattern and attributes into memory
;
;===========================================================================
;
;     by Jeff Duntemann      3 February 1989
;
; BLKBLAST is written to be called from Turbo Pascal 5.0 using the EXTERNAL
; machine-code procedure convention.
;
; This version is written to be used with the SCREENS.PAS virtual screens
; unit for Turbo Pascal 5.0.  See DDJ for 4/89.
;
; Declare the procedure itself as external using this declaration:
;
; PROCEDURE BlkBlast(ScreenEnd,StoreEnd : Pointer;
;                    ScreenX,ScreenY    : Integer;
;                    ULX,ULY            : Integer;
;                    Width,Height       : Integer;
;                    Attribute          : Byte;
;                    DeadLines          : Integer;
;                    TopStop            : Integer);
;           EXTERNAL;
;
; The idea is to store a video pattern as an assembly-language external or
; as a typed constant, and then blast it into memory so that it isn't seen
; to "flow" down from top to bottom, even on 8088 machines.
;
; During the blast itself, the attribute byte passed in the Attribute
; parameter is written to the screen along with the character information
; pointed to by the source pointer.  In effect, this means we do a byte-sized
; read from the source character data, but a word-sized write to the screen.
;
; The DeadLines parm specifies how many screen lines to skip between lines of
; the pattern.  The skipped lines are not disturbed.  TopStop provides a byte
; count that is the maximum number of bytes to blast in from the pattern.
; If a 0 is passed in TopStop, the value is ignored.
;
; To reassemble BLKBLAST:
;
; Assemble this file with MASM or TASM:  "C>MASM BLKBLAST;"
; (The semicolon is unnecessary with TASM.)
;
; No need to relink; Turbo Pascal uses the .OBJ only.
;
;========================
;
; STACK PROTOCOL
;
; This creature puts lots of things on the stack.  Study closely:
;

ONSTACK STRUC
OldBP   DW ?    ;Caller's BP value saved on the stack
RetAddr DD ?    ;Full 32-bit return address.  (This is a FAR proc!)
TopStop DW ?    ;Maximum number of chars to be copied from block pattern
DeadLns DW ?    ;Number of lines of dead space to insert between blasted lines
Attr    DW ?    ;Attribute to be added to blasted pattern
BHeight DW ?    ;Height of block to be blasted to the screen
BWidth  DW ?    ;Width of block to be blasted to the screen
ULY     DW ?    ;Y coordinate of upper left corner of the block
ULX     DW ?    ;X coordinate of the upper left corner of the block
YSize   DW ?    ;Genned max Y dimension of current visible screen
XSize   DW ?    ;Genned max X dimension of current visible screen
Block   DD ?    ;32-bit pointer to block pattern somewhere in memory
Screen  DD ?    ;32-bit pointer to an array of pointers to screen lines
ENDMRK  DB ?    ;Dummy field for stack struct size calculation
ONSTACK ENDS


CODE    SEGMENT PUBLIC
        ASSUME  CS:CODE
        PUBLIC  BlkBlast

BlkBlast PROC    FAR
         PUSH    BP               ;Save Turbo Pascal's BP value
         MOV     BP,SP            ;SP becomes new value in BP
         PUSH    DS               ;Save Turbo Pascal's DS value

;-------------------------------------------------------------------------
; If a zero is passed in TopStop, then we fill the TopStop field in the
; struct with the full size of the block, calculated by multiplying
; BWidth times BHeight.  This makes it unnecessary for the caller to
; pass the full size of the block in the TopStop parameter if topstopping
; is not required.
;-------------------------------------------------------------------------
         CMP     [BP].TopStop,0   ; See if zero was passed in TopStop
         JNZ     GetPtrs          ; If not, skip this operation
         MOV     AX,[BP].BWidth   ; Load block width into AX
         MUL     [BP].BHeight     ; Multiply by block height, to AX
         MOV     [BP].TopStop,AX  ; Put the product back into TopStop

;-------------------------------------------------------------------------
; The first important task is to get the first pointer in the ShowPtrs
; array into ES:DI.  This involved two LES operations:  The first to get
; the pointer to ShowPtrs (field Screen in the stack struct) into ES:DI,
; the second to use ES:DI to get the first ShowPtrs pointer into ES:DI.
; Remembering that ShowPtrs is an *array* of pointers, the next task is
; to index DI into the array by multiplying the top line number (ULY)
; less one (because we're one-based) by 4 using SHL and then adding that
; index to DI:
;-------------------------------------------------------------------------
GetPtrs: LES     DI,[BP].Screen   ; Address of ShowPtrs array in ES:DI
         MOV     CX,[BP].ULY      ; Load line address of block dest. to CX
         DEC     CX               ; Subtract 1 'cause we're one-based
         SHL     CX,1             ; Multiply CX by 4 by shifting it left...
         SHL     CX,1             ;  ...twice.
         ADD     DI,CX            ; Add the resulting index to DI.

         MOV     BX,DI            ; Copy offset of ShowPtrs into BX
         MOV     DX,ES            ; Copy segment of ShowPtrs into DX
         LES     DI,ES:[DI]       ; Load first line pointer into ES:DI

;-------------------------------------------------------------------------
; The inset from the left margin of the block's destination is given in
; struct field ULX.  It's one-based, so it has to be decremented by one,
; then multiplied by two using SHL since each character atom is two bytes
; in size.  The value in the stack frame is adjusted (it's not a VAR parm,
; so that's safe) and then read from the frame at the start of each line
; blast and added to the line offset in DI.
;-------------------------------------------------------------------------
         DEC     [BP].ULX         ; Subtract 1 'cause we're one-based
         SHL     [BP].ULX,1       ; Multiply by 2 to cover word moves
         ADD     DI,[BP].ULX      ; And add the adjustment to DI

;-------------------------------------------------------------------------
; One additional adjustment must be made before we start:  The Deadspace
; parm puts 1 or more lines of empty space between each line of the block
; that we're blasting onto the screen.  This value is passed in the
; DEADLNS field in the struct.  It's passed as the number of lines to skip,
; but we have to multiply it by 4 so that it becomes an index into the
; ShowPtrs array, each element of which is four bytes in size.  Like ULX,
; the value is adjusted in the stack frame and added to the stored offset
; value we keep in DX each time we set up the pointer in ES:DI to blast the
; next line.
;-------------------------------------------------------------------------
         SHL     [BP].DEADLNS,1   ; Shift dead space line count by 1...
         SHL     [BP].DEADLNS,1   ; ...and again to multiply by 4

         LDS     SI,[BP].Block    ; Load pointer to block into DS:SI

;-------------------------------------------------------------------------
; This is the loop that does the actual block-blasting.  Two counters are
; kept, and share CX by being separate values in CH and CL.  After
; each line blast, both pointers are adjusted and the counters swapped,
; the LOOP counter decremented and tested, and then the counters swapped
; again.
;-------------------------------------------------------------------------
MovEm:   MOV     CX,[BP].BWidth            ; Load atom counter into CH
         MOV     AH,BYTE PTR [BP].Attr     ; Load attribute into AH
DoChar:  LODSB               ; Load char from block storage into AL
         STOSW               ; Store AX into ES:DI; increment DI by 2
         LOOP    DoChar      ; Go back for next char if CX > 0

;-------------------------------------------------------------------------
; Immediately after a line is blasted from block to screen, we adjust.
; First we move the pointer in ES:DI to the next pointer in the
; Turbo Pascal ShowPtrs array.  Note that the source pointer does NOT
; need adjusting.  After blasting through one line of the source block,
; SI is left pointing at the first character of the next line of the
; source block.  Also note the addition of the deadspace adjustment to
; BX *before* BX is copied into DI, so that the adjustment will be
; retained through all the rest of the lines moved.  Finally, we subtract
; the number of characters in a line from TopStop, and see if there are
; fewer counts left in TopStop than there are characters in a block line.
; If so, we force BWidth to the number of remaining characters, and
; BHeight to one, so that we will blast only one remaining (short) line.
;-------------------------------------------------------------------------
         MOV     ES,DX           ; Copy ShowPtrs segment from DX into ES
         ADD     BX,4            ; Bounce BX to next pointer offset
         ADD     BX,[BP].DeadLns ; Add deadspace adjustment to BX
         LES     DI,ES:[BX]      ; Load next pointer into ES:DI
         ADD     DI,[BP].ULX     ; Add adjustment for X offset into screen

         MOV     AX,[BP].TopStop ; Load current TopStop value into AX
         SUB     AX,[BP].BWidth  ; Subtract BWidth from TopSTop value
         JBE     GoHome          ; If TopStop is <= zero, we're done.
         MOV     [BP].TopStop,AX ; Put TopStop value back in stack struct
         CMP     AX,[BP].BWidth  ; Compare what remains in TopStop to BWidth
         JAE     MovEm           ; If at least one BWidth remains, loop again
         MOV     [BP].BWidth,AX  ; Otherwise, replace BWidth with remainder
         JMP     MovEm           ;   and jump to last go-thru

;-------------------------------------------------------------------------
; When the outer loop is finished, the work is done.  Restore registers
; and return to Turbo Pascal.
;-------------------------------------------------------------------------

GoHome: POP     DS                ; Restore Turbo Pascal's
        MOV     SP,BP             ; Restore Turbo Pascal's stack pointer...
        POP     BP                ; ...and BP
        RET     ENDMRK-RETADDR-4  ; Clean up stack and return as FAR proc!
                                  ;   (would be ENDMRK-RETADDR-2 for NEAR...)

BlkBlast ENDP
CODE     ENDS
         END



[LISTING FIVE]


         TITLE  CalBlks -- External calendar pattern blocks

; By Jeff Duntemann  --  TASM 1.0  --  Last modified 3/1/89
;
; For use with CALENDAR.PAS and BLKBLAST.ASM as described in DDJ 6/89

CODE     SEGMENT WORD
         ASSUME CS:CODE


CalFrame PROC FAR
         PUBLIC CalFrame
         DB   '���������������������������͸'
         DB   '�                           �'
         DB   '���������������������������Ĵ'
         DB   '�Sun�Mon�Tue�Wed�Thu�Fri�Sat�'
         DB   '���������������������������Ĵ'
         DB   '�   �   �   �   �   �   �   �'
         DB   '���������������������������Ĵ'
         DB   '�   �   �   �   �   �   �   �'
         DB   '���������������������������Ĵ'
         DB   '�   �   �   �   �   �   �   �'
         DB   '���������������������������Ĵ'
         DB   '�   �   �   �   �   �   �   �'
         DB   '���������������������������Ĵ'
         DB   '�   �   �   �   �   �   �   �'
         DB   '���������������������������Ĵ'
         DB   '�   �   �   �   �   �   �   �'
         DB   '���������������������������;'
Calframe ENDP

CalData  PROC FAR
         PUBLIC CalData
         DB   '   �   �   �   �   �   �   �'
         DB   '  1�  2�  3�  4�  5�  6�  7�'
         DB   '  8�  9� 10� 11� 12� 13� 14�'
         DB   ' 15� 16� 17� 18� 19� 20� 21�'
         DB   ' 22� 23� 24� 25� 26� 27� 28�'
         DB   ' 29� 30� 31�   �   �   �   �'
         DB   '   �   �   �   �   �   �   �'
         DB   '   �   �   �   �   �   �   �'

CalData  ENDP


CODE     ENDS

         END