Category : Modula II Source Code
Archive   : SCROLL.ZIP
Filename : SCROLL.MOD

 
Output of file : SCROLL.MOD contained in archive : SCROLL.ZIP
IMPLEMENTATION MODULE Scroll ;

(* Window scrolling module for JPI TopSpeed Modula-2 *)
(* Roy Harvey 1988 (bix id "royharv") *)
(* Placed in the public domain - good luck *)

IMPORT Window ;

(*==========================================================================*)
PROCEDURE Min (i, j : CARDINAL) : CARDINAL ;
BEGIN ;
IF i < j THEN RETURN i ;
ELSE RETURN j ;
END ;
END Min ;

(*==========================================================================*)
PROCEDURE NumberOfLinesInWindow (W : Window.WinType) : CARDINAL ;

VAR WD : Window.WinDef ;
VAR i : CARDINAL ;

BEGIN ;
Window.Info(W, WD) ;

i := WD.Y2 - WD.Y1 + 1 ;
IF WD.FrameOn THEN
DEC(i, 2) ;
END ;

RETURN i ;

END NumberOfLinesInWindow ;

(*==========================================================================*)
PROCEDURE SetHigh (VAR ScrRec: ScrollData) : BOOLEAN ;

VAR i, j, k : CARDINAL ;

BEGIN ;

IF NOT ScrRec.HighOn THEN
RETURN FALSE ;
END ;

IF (ScrRec.High >= ScrRec.First) AND
(ScrRec.High < (ScrRec.First + ScrRec.TopToBottom)) THEN
(* We have to "turn on" the new High field *)
i := ScrRec.High - ScrRec.First + 1 ;
Window.GotoXY(1, i) ;
Window.SetPaletteColor(ScrRec.HighPaletteEntry) ;
ScrRec.WriteOneProc(ScrRec.High) ;
Window.SetPaletteColor(ScrRec.LowPaletteEntry) ;
RETURN TRUE ;
ELSE
RETURN FALSE ;
END ;

END SetHigh ;

(*==========================================================================*)
PROCEDURE SetLow (VAR ScrRec: ScrollData) : BOOLEAN ;

VAR i, j, k : CARDINAL ;

BEGIN ;

IF NOT ScrRec.HighOn THEN
RETURN FALSE ;
END ;

IF (ScrRec.High >= ScrRec.First) AND
(ScrRec.High < (ScrRec.First + ScrRec.TopToBottom)) THEN
(* We have to "turn off" the old High field *)
i := ScrRec.High - ScrRec.First + 1 ;
Window.GotoXY(1, i) ;
ScrRec.WriteOneProc(ScrRec.High) ;
END ;

RETURN TRUE ;

END SetLow ;

(*==========================================================================*)
PROCEDURE HighAt (W: Window.WinType ; VAR ScrRec : ScrollData ;
HighAtLine : CARDINAL) : BOOLEAN ;

VAR Result : BOOLEAN ;
VAR i, j, k : CARDINAL ;

BEGIN ;
Window.Use(W) ;
ScrRec.TopToBottom := NumberOfLinesInWindow(W) ;

IF NOT ScrRec.HighOn THEN
RETURN FALSE ;
END ;
Result := SetLow(ScrRec) ;
ScrRec.High := HighAtLine ;
Result := SetHigh(ScrRec) ;

RETURN Result ;

END HighAt ;

(*==========================================================================*)
PROCEDURE GeneralHighlight (W: Window.WinType ; VAR ScrRec : ScrollData ;
ScrollBy : GeneralHighCmd) : BOOLEAN ;
VAR Result : BOOLEAN ;
BEGIN ;
Window.Use(W) ;
ScrRec.TopToBottom := NumberOfLinesInWindow(W) ;
Result := SetLow(ScrRec) ;

CASE ScrollBy OF
| Scroll.WLineFirst : ScrRec.High := ScrRec.First ;
| Scroll.WLineLast : ScrRec.High := Min((ScrRec.First + ScrRec.TopToBottom - 1),
ScrRec.NumberOfScrollableEntries) ;
| Scroll.WLineNext : ScrRec.High := Min((ScrRec.First + 1),
ScrRec.NumberOfScrollableEntries) ;
| Scroll.WLinePrev : IF ScrRec.High > 1 THEN
ScrRec.High := ScrRec.High - 1 ;
END ;
END ;

Result := SetHigh(ScrRec) ;

RETURN TRUE ;

END GeneralHighlight ;

(*==========================================================================*)
PROCEDURE FullScreenAt (VAR ScrRec: ScrollData ;
FullScreenAtLine : CARDINAL) : BOOLEAN ;

VAR i, j, k : CARDINAL ;

BEGIN ;
ScrRec.First := FullScreenAtLine ;
j := ScrRec.First ;
k := Min(ScrRec.TopToBottom, ScrRec.NumberOfScrollableEntries - j + 1) ;
FOR i := 1 TO ScrRec.TopToBottom DO
Window.GotoXY(1, i) ;
IF i <= k THEN
ScrRec.WriteOneProc(j) ;
INC(j) ;
ELSE
Window.ClrEol ;
END ;
END ;

RETURN TRUE ;

END FullScreenAt ;

(*==========================================================================*)
PROCEDURE ShiftUpOne (VAR ScrRec: ScrollData): BOOLEAN ;

VAR i, j, k : CARDINAL ;

BEGIN ;

IF ScrRec.First <= 1 THEN
RETURN FALSE ;
END ;
DEC(ScrRec.First) ;
Window.GotoXY(1, 1) ;
Window.InsLine ;
ScrRec.WriteOneProc(ScrRec.First) ;

RETURN TRUE ;

END ShiftUpOne ;

(*==========================================================================*)
PROCEDURE UpByN (VAR ScrRec: ScrollData ; ByN : CARDINAL): BOOLEAN ;

VAR Result : BOOLEAN ;
VAR basis, actual, i, j, k : CARDINAL ;

BEGIN ;
(* The actual number of lines to scroll can't exceed the start point. *)
IF ScrRec.HighOn THEN basis := ScrRec.High ;
ELSE basis := ScrRec.First ; END ;
actual := Min(ByN, basis - 1) ;

FOR i := 1 TO actual DO
IF ScrRec.HighOn AND (ScrRec.High > ScrRec.First) THEN
DEC(ScrRec.High) ;
ELSE
Result := ShiftUpOne(ScrRec) ;
DEC(ScrRec.High) ;
END ;
END ;

RETURN Result ;

END UpByN ;

(*==========================================================================*)
PROCEDURE UpPage (VAR ScrRec: ScrollData): BOOLEAN ;

VAR Result : BOOLEAN ;
VAR NewFirst, i, j, k : CARDINAL ;

BEGIN ;
IF ScrRec.First > ScrRec.TopToBottom THEN
NewFirst := ScrRec.First - ScrRec.TopToBottom ;
ELSE
NewFirst := 1 ;
END ;
Result := FullScreenAt(ScrRec, NewFirst) ;
ScrRec.High := Min(ScrRec.First + ScrRec.TopToBottom - 1,
ScrRec.NumberOfScrollableEntries) ;

RETURN TRUE ;

END UpPage ;

(*==========================================================================*)
PROCEDURE ShiftDownOne (VAR ScrRec: ScrollData): BOOLEAN ;

VAR i, j, k : CARDINAL ;

BEGIN ;

IF (ScrRec.First + ScrRec.TopToBottom - 1) >= ScrRec.NumberOfScrollableEntries THEN
RETURN FALSE ;
END ;
INC(ScrRec.First) ;
Window.GotoXY(1, 1) ;
Window.DelLine ;

j := ScrRec.First + ScrRec.TopToBottom - 1 ;
IF j <= ScrRec.NumberOfScrollableEntries THEN
Window.GotoXY(1, ScrRec.TopToBottom) ;
ScrRec.WriteOneProc(j) ;
END ;

RETURN TRUE ;

END ShiftDownOne ;

(*==========================================================================*)
PROCEDURE DownByN (VAR ScrRec: ScrollData ; ByN : CARDINAL): BOOLEAN ;

VAR Result : BOOLEAN ;
VAR basis, actual, i, j, k : CARDINAL ;

BEGIN ;
(* The actual number of lines to scroll go past the end point. *)
IF ScrRec.HighOn THEN basis := ScrRec.High ;
ELSE basis := ScrRec.First ; END ;
actual := Min(ByN, ScrRec.NumberOfScrollableEntries - basis) ;

FOR i := 1 TO actual DO
IF ScrRec.HighOn AND
(ScrRec.High < (ScrRec.First + ScrRec.TopToBottom - 1)) AND
(ScrRec.High < ScrRec.NumberOfScrollableEntries) THEN
INC(ScrRec.High) ;
ELSE
Result := ShiftDownOne(ScrRec) ;
INC(ScrRec.High) ;
END ;
END ;

RETURN Result ;

END DownByN ;

(*==========================================================================*)
PROCEDURE DownPage (VAR ScrRec: ScrollData): BOOLEAN ;

VAR Result : BOOLEAN ;
VAR NewFirst, i, j, k : CARDINAL ;

BEGIN ;
IF ScrRec.TopToBottom >= ScrRec.NumberOfScrollableEntries THEN
ScrRec.High := ScrRec.First ;
RETURN FALSE ;
END ;
NewFirst := ScrRec.First + ScrRec.TopToBottom ;
IF NewFirst > ScrRec.NumberOfScrollableEntries THEN
NewFirst := ScrRec.NumberOfScrollableEntries - ScrRec.TopToBottom + 1 ;
END ;
Result := Scroll.FullScreenAt(ScrRec, NewFirst) ;
ScrRec.High := ScrRec.First ;

RETURN TRUE ;

END DownPage ;

(*==========================================================================*)
PROCEDURE ToEnd (VAR ScrRec: ScrollData): BOOLEAN ;

VAR Result : BOOLEAN ;
VAR NewFirst, i, j, k : CARDINAL ;

BEGIN ;
ScrRec.High := ScrRec.NumberOfScrollableEntries ;

IF ScrRec.TopToBottom >= ScrRec.NumberOfScrollableEntries THEN
RETURN FALSE ;
END ;
NewFirst := ScrRec.NumberOfScrollableEntries - ScrRec.TopToBottom + 1 ;
Result := Scroll.FullScreenAt(ScrRec, NewFirst) ;

RETURN TRUE ;

END ToEnd ;

(*==========================================================================*)
PROCEDURE ScrollTo (W: Window.WinType ; VAR ScrRec : ScrollData ;
ScrollToLine : CARDINAL) : BOOLEAN ;

VAR Result : BOOLEAN ;
VAR i, j, k : CARDINAL ;

BEGIN ;
Window.Use(W) ;
ScrRec.TopToBottom := NumberOfLinesInWindow(W) ;

Result := SetLow(ScrRec) ;
IF ScrRec.HighOn AND
(ScrollToLine >= ScrRec.First) AND
(ScrollToLine < (ScrRec.First + ScrRec.TopToBottom)) THEN
ScrRec.High := ScrollToLine ;
ELSE
Result := FullScreenAt(ScrRec, ScrollToLine) ;
ScrRec.High := ScrRec.First ;
END ;
Result := SetHigh(ScrRec) ;
RETURN Result ;

END ScrollTo ;

(*==========================================================================*)
PROCEDURE GeneralScroll (W: Window.WinType ; VAR ScrRec : ScrollData ;
ScrollBy : GeneralScrollCmd) : BOOLEAN ;

VAR Result : BOOLEAN ;
VAR i, j, k : CARDINAL ;

BEGIN ;
Window.Use(W) ;
ScrRec.TopToBottom := NumberOfLinesInWindow(W) ;
Result := SetLow(ScrRec) ;

CASE ScrollBy OF
| Scroll.ScrHome : Result := FullScreenAt(ScrRec, 1) ;
ScrRec.High := 1 ;
| Scroll.ScrEnd : Result := ToEnd (ScrRec) ;
| Scroll.ScrUp : Result := UpByN (ScrRec, 1) ;
| Scroll.ScrDown : Result := DownByN (ScrRec, 1) ;
| Scroll.ScrPgUp : Result := UpPage (ScrRec) ;
| Scroll.ScrPgDown : Result := DownPage(ScrRec) ;
END ;

Result := SetHigh(ScrRec) ;

RETURN TRUE ;

END GeneralScroll ;

(*==========================================================================*)
PROCEDURE ScrollInit (W: Window.WinType; VAR ScrRec : ScrollData) : BOOLEAN ;

VAR Result : BOOLEAN ;
VAR i, j, k : CARDINAL ;

BEGIN ;
Window.Use(W) ;
ScrRec.TopToBottom := NumberOfLinesInWindow(W) ;

Result := Scroll.FullScreenAt(ScrRec, 1) ;
ScrRec.High := ScrRec.First ;
IF ScrRec.HighOn THEN
Result := SetHigh(ScrRec) ;
END ;
RETURN Result ;

END ScrollInit ;

(*==========================================================================*)
PROCEDURE ScrollReset (W: Window.WinType; VAR ScrRec : ScrollData) : BOOLEAN ;

VAR Result : BOOLEAN ;
VAR i, j, k : CARDINAL ;

BEGIN ;
Window.Use(W) ;
ScrRec.TopToBottom := NumberOfLinesInWindow(W) ;

Result := Scroll.FullScreenAt(ScrRec, ScrRec.First) ;
IF ScrRec.HighOn THEN
Result := SetHigh(ScrRec) ;
END ;
RETURN Result ;

END ScrollReset ;

(*==========================================================================*)
BEGIN ;

DfltP[0].Fore := Window.Color( 7) ; DfltP[0].Back := Window.Color( 0) ;
DfltP[1].Fore := Window.Color( 7) ; DfltP[1].Back := Window.Color( 1) ;
DfltP[2].Fore := Window.Color( 7) ; DfltP[2].Back := Window.Color( 4) ;
DfltP[3].Fore := Window.Color( 0) ; DfltP[3].Back := Window.Color( 3) ;
DfltP[4].Fore := Window.Color(11) ; DfltP[4].Back := Window.Color( 4) ;
DfltP[5].Fore := Window.Color( 0) ; DfltP[5].Back := Window.Color( 5) ;
DfltP[6].Fore := Window.Color( 1) ; DfltP[6].Back := Window.Color( 6) ;
DfltP[7].Fore := Window.Color( 0) ; DfltP[7].Back := Window.Color( 7) ;
DfltP[8].Fore := Window.Color(10) ; DfltP[8].Back := Window.Color( 0) ;
DfltP[9].Fore := Window.Color(15) ; DfltP[9].Back := Window.Color( 0) ;

DfltLowPE := 0 ;
DfltHighPE := 7 ;

END Scroll.


  3 Responses to “Category : Modula II Source Code
Archive   : SCROLL.ZIP
Filename : SCROLL.MOD

  1. Very nice! Thank you for this wonderful archive. I wonder why I found it only now. Long live the BBS file archives!

  2. This is so awesome! 😀 I’d be cool if you could download an entire archive of this at once, though.

  3. But one thing that puzzles me is the “mtswslnkmcjklsdlsbdmMICROSOFT” string. There is an article about it here. It is definitely worth a read: http://www.os2museum.com/wp/mtswslnk/