619 lines
23 KiB
Plaintext
619 lines
23 KiB
Plaintext
|
_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 '<27><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>'
|
|||
|
DB '<27> <20>'
|
|||
|
DB '<27><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>Ĵ'
|
|||
|
DB '<27>Sun<75>Mon<6F>Tue<75>Wed<65>Thu<68>Fri<72>Sat<61>'
|
|||
|
DB '<27><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>Ĵ'
|
|||
|
DB '<27> <20> <20> <20> <20> <20> <20> <20>'
|
|||
|
DB '<27><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>Ĵ'
|
|||
|
DB '<27> <20> <20> <20> <20> <20> <20> <20>'
|
|||
|
DB '<27><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>Ĵ'
|
|||
|
DB '<27> <20> <20> <20> <20> <20> <20> <20>'
|
|||
|
DB '<27><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>Ĵ'
|
|||
|
DB '<27> <20> <20> <20> <20> <20> <20> <20>'
|
|||
|
DB '<27><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>Ĵ'
|
|||
|
DB '<27> <20> <20> <20> <20> <20> <20> <20>'
|
|||
|
DB '<27><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>Ĵ'
|
|||
|
DB '<27> <20> <20> <20> <20> <20> <20> <20>'
|
|||
|
DB '<27><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>;'
|
|||
|
Calframe ENDP
|
|||
|
|
|||
|
CalData PROC FAR
|
|||
|
PUBLIC CalData
|
|||
|
DB ' <20> <20> <20> <20> <20> <20> <20>'
|
|||
|
DB ' 1<> 2<> 3<> 4<> 5<> 6<> 7<>'
|
|||
|
DB ' 8<> 9<> 10<31> 11<31> 12<31> 13<31> 14<31>'
|
|||
|
DB ' 15<31> 16<31> 17<31> 18<31> 19<31> 20<32> 21<32>'
|
|||
|
DB ' 22<32> 23<32> 24<32> 25<32> 26<32> 27<32> 28<32>'
|
|||
|
DB ' 29<32> 30<33> 31<33> <20> <20> <20> <20>'
|
|||
|
DB ' <20> <20> <20> <20> <20> <20> <20>'
|
|||
|
DB ' <20> <20> <20> <20> <20> <20> <20>'
|
|||
|
|
|||
|
CalData ENDP
|
|||
|
|
|||
|
|
|||
|
CODE ENDS
|
|||
|
|
|||
|
END
|
|||
|
|