{=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
=-=-=-=-=-=-                                                     -=-=-=-=-=-=
-=-=-=-                   Graphics Programming Unit                   -=-=-=-
=-=-                                                                     -=-=
-=-                 Copyright (c) Chris Lattner 1996, 1997                -=-
=-=-                                                                     -=-=
-=-=-=-        This source code is part of the GraphPro series at:    -=-=-=-
=-=-=-=-=-=-        http://nondot.org/~sabre/graphpro      -=-=-=-=-=-=
-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=}

UNIT GraphPro;
{$A+ Align all data on word boundaries       }
{$B- Enable short circuit boolean evaluation }
{$D+ Enable debugging information            }
{$E- Disable x87 emmulation                  }
{$F- Do not force far calls                  }
{$G+ Enable 286 instructions                 }
{$I- Disable IO checking                     }
{$N- Disable x87 support                     }
{$O- Disable overlay support                 }
{$Q- Disable overflow checking               }
{$R- Disable range checking                  }
{$S- Disable stack checking                  }
{$T- Disable type checking on pointers       }
{$V- Disable VAR type checking               }
{$X+ Enable Extended syntax                  }
{$Y- Disable symbol reference info           }

{----------------------------------------------------------------------------
 -------------------===========} INTERFACE {============---------------------
 ----------------------------------------------------------------------------}
TYPE
  RectType = RECORD                    { A rectangle.                  }
    X1, Y1, X2, Y2 : INTEGER;
  END;

  ScreenBufferType = ARRAY[0..63999] OF BYTE;
  ScreenBufferPtr = ^ScreenBufferType;
  ScreenType = RECORD
    Buffer  : ScreenBufferPtr;         { Pointer to the screen buffer  }
    DBuffer : BOOLEAN;                 { Are we in double buffer mode? }
    YTable  : ARRAY[0..199] OF WORD;   { Y can range from 0 - 199      }
    Width   : WORD;                    { Width of the current screen   }
    Clip    : RectType;                { Current clipping boundaries   }
  END;

  FontType = RECORD
    Data : ScreenBufferPtr;        { Pointer to an array of bytes     }
    Height,                        { Size of a single character       }
    Width,
    Depth,                         { Depth in bits                    }
    FirstChar,                     { First char in font               }
    LastChar,                      { Last char in font                }
    CharSize,                      { Size of each character in bytes  }
    Background : BYTE;             { 0 = clear                        }
    Size       : WORD;             { Size of the font in memory       }
  END;

  IIBProcedure   = PROCEDURE(X, Y : INTEGER; C : BYTE);
  IIIIBProcedure = PROCEDURE(X1, Y1, X2, Y2 : INTEGER; C : BYTE);
  FIISBProcedure = PROCEDURE(F : FontType; X, Y : INTEGER; S : STRING; C : BYTE);
VAR
  Screen : ScreenType;
  SystemFont : FontType;

  SetPixel : IIBProcedure;   { Define SetPixel interface }
  Line     : IIIIBProcedure; { Define Line interface     }
  WriteG1  : FIISBProcedure; { Define WriteG1 interface  }

PROCEDURE InitGraph;                                { Initialize Graphics   }
PROCEDURE CloseGraph;                               { Shut down graphics    }
PROCEDURE CalcScreenY(Width : WORD);

{ SetClipBoundary - Sets the extents of the clipping boundary.  This controls
 functions that end with the letter "C" (ex: LineC) that clip their results
 to a window.  X1 must be less than X2 and Y1 must be less than Y2.         }
PROCEDURE SetClipBoundary(X1, Y1, X2, Y2 : INTEGER);

{ ClippingOn - Makes the default routines clip or not                       }
PROCEDURE Clipping(State : BOOLEAN);

PROCEDURE InitDoubleBuffer;                         { Initilize DB mode     }
PROCEDURE CloseDoubleBuffer;
PROCEDURE FlipPage;                                 { Flip the current page }

{ ClrScr - Clears the screen to a color.                                    }
PROCEDURE ClrScr(Color : BYTE);

PROCEDURE SetPixelNC(X, Y : INTEGER; Color : BYTE);{ Draw an unclipped pixel }
PROCEDURE SetPixelC (X, Y : INTEGER; Color : BYTE);{ Draw a clipped pixel    }
FUNCTION  GetPixel(X, Y : INTEGER) : BYTE;         { Read a pixel            }

{ LineC - A wrapper around the Line routine that clips the line to the
 current clip area.                                                         }
PROCEDURE LineC(X1, Y1, X2, Y2 : INTEGER; Color : BYTE);

{ LineNC - Encapsulates all of the four different kinds of lines into
 one general call (It also sorts points for you!)...                        }
PROCEDURE LineNC(X1, Y1, X2, Y2 : INTEGER; Color : BYTE);

{ WriteG1 - Writes a text string to the screen with the specified font,
 color, and coordinates.                                                    }
PROCEDURE WriteG1NC(Font : FontType; X, Y : INTEGER; Text : STRING; Color : BYTE);
PROCEDURE WriteG1C (Font : FontType; X, Y : INTEGER; Text : STRING; Color : BYTE);

{ LoadBIOSFont - copies a font that is in you ROM into a Font structure.    }
PROCEDURE LoadBIOSFont(VAR Font : FontType; Height : BYTE);

{ DeleteFont - Releases the memory used by the font for other things        }
PROCEDURE DeleteFont(VAR Font : FontType);

{ The next four procedures are all just shortcuts to line drawing... Make
 sure that the points are sorted correctly for each call...  None of these
 procedures do any clipping, so call at your own risk!                      }

{ HLine - X1 must be less than X2 }
PROCEDURE HLine(X1, Y, X2 : INTEGER; Color : BYTE); { Horizontal line       }
{ VLine - Y1 must be less than Y2 }
PROCEDURE VLine(X, Y1, Y2 : INTEGER; Color : BYTE); { Vertical line         }
{ YMajorLine - DeltaY must be greater than DeltaX, Sort by Y's }
PROCEDURE YMajorLine(X1, Y1, X2, Y2 : INTEGER; Color : BYTE); { Y-Major     }
{ XMajorLine - DeltaX must be greater than DeltaY, Sort by X's }
PROCEDURE XMajorLine(X1, Y1, X2, Y2 : INTEGER; Color : BYTE); { X-Major     }

{ ReadTimer - Returns the number of BIOS timer ticks since midnight.  Each
 tick lasts approximately 18.2 times a second.                              }
FUNCTION ReadTimer : LONGINT;

{----------------------------------------------------------------------------
 -------------------=========} IMPLEMENTATION {=========---------------------
 ----------------------------------------------------------------------------}

FUNCTION ReadTimer : LONGINT; ASSEMBLER;
ASM mov AX, 40h; mov ES, AX; mov AX, ES:[6Ch]; mov DX, ES:[6Eh] END;

PROCEDURE CalcScreenY(Width : WORD);  { Allow for future expansion }
VAR I : INTEGER;
BEGIN
  FOR I := 0 TO 199 DO
    Screen.YTable[I] := I*Width;
END;

PROCEDURE SetClipBoundary(X1, Y1, X2, Y2 : INTEGER);
BEGIN
  Screen.Clip.X1 := X1; Screen.Clip.Y1 := Y1; { Update global variables }
  Screen.Clip.X2 := X2; Screen.Clip.Y2 := Y2;
END;

PROCEDURE Clipping(State : BOOLEAN);
BEGIN
  IF State THEN             { Assign the pointers to the routines that clip }
  BEGIN
    SetPixel  := SetPixelC;
    Line      := LineC;
    WriteG1   := WriteG1C;
  END
  ELSE                { Assign the pointers to the routines that don't clip }
  BEGIN
    SetPixel  := SetPixelNC;
    Line      := LineNC;
    WriteG1   := WriteG1NC;
  END;
END;

PROCEDURE InitGraph;
BEGIN
  ASM
    mov AX, 0013h    { Function 0, mode 13h }
    int 10h
  END;
  SetClipBoundary(0, 0, 319, 199);
  Screen.Buffer := PTR($A000, 0);   { Set up the screen buffer pointer }
  Screen.Width := 320;
  CalcScreenY(320);
  LoadBIOSFont(SystemFont, 8);
END;

PROCEDURE CloseGraph; ASSEMBLER;
ASM
  call CloseDoubleBuffer
  mov AX, 0003h           { Function 0, Mode 3 - Text Mode }
  int 10h
END;

PROCEDURE InitDoubleBuffer;
BEGIN
  IF NOT Screen.DBuffer THEN  { Make sure that we aren't already in DB mode! }
  BEGIN
    GETMEM(Screen.Buffer, 64000);
    Screen.DBuffer := TRUE;   { That's all there is to it!                   }
  END;
END;

PROCEDURE CloseDoubleBuffer;
BEGIN
  IF Screen.DBuffer THEN
  BEGIN
    FREEMEM(Screen.Buffer, 64000);   { Release memory     }
    Screen.Buffer := PTR($A000, 0);  { Fix memory pointer }
    Screen.DBuffer := FALSE;         { Restore flag       }
  END;
END;

PROCEDURE FlipPage; ASSEMBLER;
ASM
  cmp Screen.DBuffer, 0
  je @Done                { Can't flip if no second buffer! }

  push DS
  mov CX, 64000 / 4
  mov AX, 0A000h
  mov ES, AX
  xor DI, DI
  lds SI, Screen.Buffer
  cld
  db $66; rep movsw
  pop DS
@Done:
END;

PROCEDURE ClrScr(Color : BYTE); ASSEMBLER;
ASM
  les DI, Screen.Buffer
  mov CX, 64000 / 4

  mov AL, Color
  mov AH, AL
  mov BX, AX
  db $66; shl AX, 16
  mov AX, BX

  db $66; rep stosw
END;

PROCEDURE SetPixelNC(X, Y : INTEGER; Color : BYTE); ASSEMBLER;
ASM
  les DI, Screen.Buffer
  add DI, X
  mov BX, Y       { Y is an index into the ScreenY array        }
  add BX, BX      { Multipy by two because each entry is a word }
  add DI, DS:[BX+OFFSET Screen.YTable]

  mov AL, Color
  mov ES:[DI], AL
END;

PROCEDURE SetPixelC(X, Y : INTEGER; Color : BYTE); ASSEMBLER;
ASM
  mov CX, X
  cmp CX, Screen.Clip.X1    { Clip the X coordinate }
  jl @Clipped
  cmp CX, Screen.Clip.X2
  jg @Clipped

  mov BX, Y       { Y is an index into the ScreenY array        }
  cmp BX, Screen.Clip.Y1    { Clip the Y coordinate }
  jl @Clipped
  cmp BX, Screen.Clip.Y2
  jg @Clipped

  les DI, Screen.Buffer
  add DI, CX
  add BX, BX      { Multipy by two because each entry is a word }
  add DI, DS:[BX+OFFSET Screen.YTable]

  mov AL, Color
  mov ES:[DI], AL
@Clipped:
END;

FUNCTION GetPixel(X, Y : INTEGER) : BYTE; ASSEMBLER;
ASM
  les DI, Screen.Buffer
  add DI, X
  mov BX, Y       { Y is an index into the ScreenY array        }
  add BX, BX      { Multipy by two because each entry is a word }
  add DI, DS:[BX+OFFSET Screen.YTable]

  mov AL, ES:[DI]
END;

{----------------------------------------------------------------------------
 ----------------------========= Line Routines =========---------------------
 ----------------------------------------------------------------------------}
PROCEDURE HLine(X1, Y, X2 : INTEGER; Color : BYTE); ASSEMBLER;
ASM
  les DI, Screen.Buffer  { Only load ES and DI at the start }
  add DI, X1
  mov BX, Y       { Y is an index into the ScreenY array        }
  add BX, BX      { Multipy by two because each entry is a word }
  add DI, DS:[BX+OFFSET Screen.YTable]

  { At this point, DI points to the first pixel in the line.  }
  { Now we will calculate how many times to loop (X2-X1+1)... }

  mov CX, X2
  mov AL, Color   { Load the color }
  mov AH, AL
  sub CX, X1
  inc CX

  test DI, 1      { Are we on an odd address?  }
  jz @Even
  stosb           { Store the first byte       }
  dec CX          { Decrement the counter one  }
@Even:            { Even address               }
  shr CX, 1       { Do half as many transfers  }
  rep stosw       { Copy all of the even words }
  adc CX, 0       { If there is a pixel left over, set CX to 1 }
  rep stosb       { If there is a pixel left over, fill it!    }
END;

PROCEDURE VLine(X, Y1, Y2 : INTEGER; Color : BYTE); ASSEMBLER;
ASM
  les DI, Screen.Buffer  { Only load ES and DI at the start }
  add DI, X
  mov BX, Y1      { Y1 is an index into the ScreenY array       }
  add BX, BX      { Multipy by two because each entry is a word }
  add DI, DS:[BX+OFFSET Screen.YTable]

  { At this point, DI points to the first pixel in the line.  }
  { Now we will calculate how many times to loop (Y2-Y1+1)... }

  mov CX, Y2
  sub CX, Y1      { Calculate the Delta Y  }
  inc CX

  mov DX, Screen.Width { 320 }
  mov AL, Color   { Load the color         }

  mov BX, CX
  and BX, 3       { Get remainder of CX DIV 4 }
  shr CX, 2       { Repeated four times    }
  add BX, BX      { Index into a word table}
  add BX, OFFSET @JumpTable
  jmp WORD PTR CS:[BX]

@JumpTable:
  dw OFFSET @Iteration5
  dw OFFSET @Iteration4
  dw OFFSET @Iteration3
  dw OFFSET @Iteration2

@Iteration1:
  mov ES:[DI], AL { Set a pixel            }
  add DI, DX      { Increment address      }

@Iteration2:
  mov ES:[DI], AL { Set a pixel            }
  add DI, DX      { Increment address      }

@Iteration3:
  mov ES:[DI], AL { Set a pixel            }
  add DI, DX      { Increment address      }

@Iteration4:
  mov ES:[DI], AL { Set a pixel            }
  add DI, DX      { Increment address      }

@Iteration5:
  dec CX          { Decrement loop counter }
  jns @Iteration1 { Repeat if neccesary    }
END;

PROCEDURE XMajorLine(X1, Y1, X2, Y2 : INTEGER; Color : BYTE); ASSEMBLER;
ASM
  les DI, Screen.Buffer
  mov BX, Y1
  add BX, BX
  add DI, WORD [BX+Screen.YTable]  { DI := Y1*320+X1 }
  add DI, X1

  mov BX, X2   { DeltaX := X2-X1+1 }
  mov AX, Y2   { DeltaY := Y2-Y1+1 }
  sub BX, X1
  sub AX, Y1

  cwd
  xor AX, DX
  sub AX, DX  { DeltaX := ABS(DeltaX) }

  and DL, 00101000b { IF negative, DX is -1 }
  { Here, SUB has 5 in the Opcode field, where add has 0 }
  add DL, $C7       { Rest of the MOD R/M byte }
  mov BYTE [CS:@ModifyAdd1+1], DL
  mov BYTE [CS:@ModifyAdd2+1], DL
  mov BYTE [CS:@ModifyAdd3+1], DL
  mov BYTE [CS:@ModifyAdd4+1], DL

  mov CX, Screen.Width            { Modify the opcode field     }
  mov WORD [CS:@ModifyAdd1+2], CX  { Stick in the correct Screen.Width }
  mov WORD [CS:@ModifyAdd2+2], CX  { Stick in the correct Screen.Width }
  mov WORD [CS:@ModifyAdd3+2], CX  { Stick in the correct Screen.Width }
  mov WORD [CS:@ModifyAdd4+2], CX  { Stick in the correct Screen.Width }

  inc BX
  inc AX

  xchg AX, BX
  { ShortLen := DeltaX DIV DeltaY
    Rem := DeltaX MOD DeltaY }

  xor DX, DX  { Clear upper word       }
  div BX      { AX = ShortLen DX = Rem }
  mov CX, AX   { CX = ShortLen }

  xor AX, AX   { Rem is already SHL 16 }
  div BX       { Incr := (LONGINT(Rem) SHL 16) DIV DeltaY }

  mov SI, AX   { SI := Incr }
  mov DX, CX             { DX = ShortLen                               }
  mov AH, BL             { AH = DeltaY                                 }
  mov AL, Color
  xor CX, CX             { Initialize CX to zero                       }

  push BP
  mov BP, BX
  mov BX, 32768          { BX = 0.5 SHL 16                             }
  and BP, 3       { Get remainder of CX DIV 4               }
  shr AH, 2       { Repeated four times                     }
  add BP, BP      { Index into a word table                 }
  jmp WORD PTR CS:[@JumpTable+BP]        { Clears the cache }

@JumpTable:
  dw OFFSET @Iteration5 { Enter at the correct place... }
  dw OFFSET @Iteration4
  dw OFFSET @Iteration3
  dw OFFSET @Iteration2

@Iteration1:
  add BX, SI             { Update our fraction...                      }
  adc CX, DX             { If it overflows, then draw a long line!     }
  rep stosb              { Draw the run (Sets CX to zero)              }
@ModifyAdd1:
  add DI, 12345          { Next Y!                                     }

@Iteration2:
  add BX, SI             { Update our fraction...                      }
  adc CX, DX             { If it overflows, then draw a long line!     }
  rep stosb              { Draw the run (Sets CX to zero)              }
@ModifyAdd2:
  add DI, 12345          { Next Y!                                     }

@Iteration3:
  add BX, SI             { Update our fraction...                      }
  adc CX, DX             { If it overflows, then draw a long line!     }
  rep stosb              { Draw the run (Sets CX to zero)              }
@ModifyAdd3:
  add DI, 12345          { Next Y!                                     }

@Iteration4:
  add BX, SI             { Update our fraction...                      }
  adc CX, DX             { If it overflows, then draw a long line!     }
  rep stosb              { Draw the run (Sets CX to zero)              }
@ModifyAdd4:
  add DI, 12345          { Next Y!                                     }

@Iteration5:
  dec AH
  jns @Iteration1        { Try again                                   }

  pop BP
END;

PROCEDURE YMajorLine(X1, Y1, X2, Y2 : INTEGER; Color : BYTE); ASSEMBLER;
ASM
  mov AX, X2; sub AX, X1   { Calculate DeltaX }
  cwd
  xor AX, DX
  sub AX, DX
  mov BX, DX              { Save this to tell that we swaped... }
  mov DX, AX              { AX = ABS(X2-X1) }
  xor AX, AX

  mov CX, Y2; sub CX, Y1   { Calculate DeltaY }
  div CX                   { Slope := (LONGINT(DeltaY) SHL 16) DIV DeltaX; }

  mov DX, AX
  inc CX
  db $66; shl DX, 16       { DX is the Increment variable    }

  mov DX, BX     { SE or SW }
  and DX, -640
  add DX, 320    { Decide between left and right }

  mov AL, BL
  and AL, 8
  add AL, 11h  { Make either a adc or sbb }
  mov BYTE PTR [CS:@Iteration1+1], AL { Change adc into sbb }
  mov BYTE PTR [CS:@Iteration2+1], AL { Change adc into sbb }
  mov BYTE PTR [CS:@Iteration3+1], AL { Change adc into sbb }
  mov BYTE PTR [CS:@Iteration4+1], AL { Change adc into sbb }

  les DI, Screen.Buffer
  mov BX, Y1

  { Start out a half a pixel in... }
  db $66; add DI, -320; dw 8000h { mov EDI, 80000000h }
  mov AL, Color
  add BX, BX
  add DI, WORD [Screen.YTable+BX]

{ CX is still set to Y-Delta for counter }
  mov BX, CX
  add DI, X1

  and BX, 3       { Get remainder of CX DIV 4               }
  shr CX, 2       { Repeated four times                     }
  add BX, BX      { Index into a word table                 }
  clc             { Make extra sure the carry flag is clear }
  jmp WORD PTR CS:[@JumpTable+BX]        { Clears the cache }

@JumpTable:
  dw OFFSET @Iteration5 { Enter at the right place... }
  dw OFFSET @Iteration4
  dw OFFSET @Iteration3
  dw OFFSET @Iteration2

@Iteration1:
  db $66; adc DI, DX  { 1 cycle                    }
  mov ES:[DI], AL     { 1 cycle + 1 cycle AGI lock }
@Iteration2:
  db $66; adc DI, DX  { 1 cycle                    }
  mov ES:[DI], AL     { 1 cycle + 1 cycle AGI lock }
@Iteration3:
  db $66; adc DI, DX  { 1 cycle                    }
  mov ES:[DI], AL     { 1 cycle + 1 cycle AGI lock }
@Iteration4:
  db $66; adc DI, DX  { 1 cycle                    }
  mov ES:[DI], AL     { 1 cycle + 1 cycle AGI lock }
@Iteration5:
  dec CX      { Does not affect Carry flag } { 1 cycle  }
  jns @Iteration1     { Loop YDelta Times! } { 3 cycles }

  { 16 cycles total }
  { 16/4 = 4 cycles per pixel! }
END;

PROCEDURE LineNC(X1, Y1, X2, Y2 : INTEGER; Color : BYTE); ASSEMBLER;
ASM
  mov AX, Y2; sub AX, Y1
  cwd; xor AX, DX; sub AX, DX  { DeltaY := ABS(Y2-Y1) }
  jz @DeltaYIsZero
  mov BX, AX
  and DL, 2
  mov CL, DL  { Set bit #1 if Y's are backwards }

  mov AX, X2; sub AX, X1
  cwd; xor AX, DX; sub AX, DX  { DeltaX := ABS(X2-X1) }
  jz @DeltaXIsZero
  and DL, 1
  or CL, DL   { Set bit #0 if X's are backwards }

@DeltaXNotZero:
  cmp AX, BX
  jge @XMajorLine      { IF DeltaY > DeltaX THEN }

  and CL, 2
  jz @NoSwap3
  mov AX, X1
  xchg X2, AX
  mov X1, AX
  mov AX, Y1
  xchg Y2, AX
  mov Y1, AX
@NoSwap3:
{ push X1 push Y1 push X2 push Y2 push WORD [Color]
  call YMajorLine      { YMajorLine(X1, Y1, X2, Y2, Color) }
  pop BP
  jmp YMajorLine   { Everything is already pushed!  Just jmp to proc! }

@XMajorLine:           { IF DeltaX >= DeltaY THEN }
  and CL, 1
  jz @NoSwap4
  mov AX, X1
  xchg X2, AX
  mov X1, AX
  mov AX, Y1
  xchg Y2, AX
  mov Y1, AX
@NoSwap4:
{ push X1 push Y1 push X2 push Y2 push WORD [Color]
  call XMajorLine      { XMajorLine(X1, Y1, X2, Y2, Color) }
  pop BP
  jmp XMajorLine   { Everything is already pushed!  Just jmp to proc! }

@DeltaYIsZero:
  mov AX, X1
  mov CX, X2
  mov BX, Y1
  cmp AX, CX
  jl @NoSwap1
  xchg AX, CX
@NoSwap1:
  push AX
  push BX
  push CX
  push WORD [Color]
  call HLine        { HLine(X1, Y1, X2, Color) }
  jmp @Done

@DeltaXIsZero:
  mov AX, X1
  mov BX, Y1
  mov DX, Y2
  and CL, 2
  jz @NoSwap2
  xchg BX, DX
@NoSwap2:
  push AX
  push BX
  push DX
  push WORD [Color]    { VLine(X1, Y1, Y2, Color) }
  call VLine
@Done:
END;

{ LineC - This procedure clips a line to the current clip boundaries and
 then calls the Line procedure with the clipped coordinates.  If the line
 lies completely outside of the clip boundary, then the Line routine is not
 called.  This procedure uses the well known Cohen-Sutherland line clipping
 algorithm to clip each coordinate.                                        }
PROCEDURE LineC(X1, Y1, X2, Y2 : INTEGER; Color : BYTE);
CONST
  CodeBottom = 1; CodeTop    = 2;             { BitFields for output codes }
  CodeLeft   = 4; CodeRight  = 8;

FUNCTION CompOutCode(X, Y : INTEGER) : BYTE; ASSEMBLER;  { Nested function }
ASM
  mov AX, 0
  mov DX, Y
  mov CX, X
  cmp DX, Screen.Clip.Y2
  jle @NoCodeBottom
  or AX, CodeBottom
  jmp @NoCodeTop
@NoCodeBottom:
  cmp DX, Screen.Clip.Y1
  jge @NoCodeTop
  or AX, CodeTop
@NoCodeTop:
  cmp CX, Screen.Clip.X2
  jle @NoCodeRight
  or AX, CodeRight
  jmp @NoCodeLeft
@NoCodeRight:
  cmp CX, Screen.Clip.X1
  jge @NoCodeLeft
  or AX, CodeLeft
@NoCodeLeft:
END;

VAR
  OutCode0,         { The code of the first endpoint  }
  OutCode1,         { The code of the second endpoint }
  OutCodeOut : BYTE;
  X, Y : INTEGER;
BEGIN
  OutCode0 := CompOutCode(X1, Y1);            { Compute the original codes   }
  OutCode1 := CompOutCode(X2, Y2);

  WHILE (OutCode0 <> 0) OR (OutCode1 <> 0) DO { While not Trivially Accepted }
  BEGIN
    IF (OutCode0 AND OutCode1) <> 0 THEN      { Trivial Reject }
      EXIT
    ELSE
    BEGIN        { Failed both tests, so calculate the line segment to clip }
      IF OutCode0 > 0 THEN
        OutCodeOut := OutCode0    { Clip the first point }
      ELSE
        OutCodeOut := OutCode1;   { Clip the last point  }

      IF (OutCodeOut AND CodeBottom) = CodeBottom THEN
      BEGIN               { Clip the line to the bottom of the viewport     }
        Y := Screen.Clip.Y2;
        X := X1+LONGINT(X2-X1)*LONGINT(Y-Y1) DIV (Y2 - Y1);
      END
      ELSE IF (OutCodeOut AND CodeTop) = CodeTop THEN
      BEGIN               { Clip the line to the top of the viewport        }
        Y := Screen.Clip.Y1;
        X := X1+LONGINT(X2-X1)*LONGINT(Y-Y1) DIV (Y2 - Y1);
      END
      ELSE IF (OutCodeOut AND CodeRight) = CodeRight THEN
      BEGIN               { Clip the line to the right edge of the viewport }
        X := Screen.Clip.X2;
        Y := Y1+LONGINT(Y2-Y1)*LONGINT(X-X1) DIV (X2 - X1);
      END
      ELSE IF (OutCodeOut AND CodeLeft) = CodeLeft THEN
      BEGIN               { Clip the line to the left edge of the viewport  }
        X := Screen.Clip.X1;
        Y := Y1+LONGINT(Y2-Y1)*LONGINT(X-X1) DIV (X2 - X1);
      END;

      IF (OutCodeOut = OutCode0) THEN       { Modify the first coordinate   }
      BEGIN
        X1 := X; Y1 := Y;                   { Update temporary variables    }
        OutCode0 := CompOutCode(X1, Y1);    { Recalculate the OutCode       }
      END
      ELSE                                  { Modify the second coordinate  }
      BEGIN
        X2 := X; Y2 := Y;                   { Update temporary variables    }
        OutCode1 := CompOutCode(X2, Y2);    { Recalculate the OutCode       }
      END;
    END;
  END;

  LineNC(X1, Y1, X2, Y2, Color);            { Draw the new line!            }
END;

{----------------------------------------------------------------------------
 ----------------------========= Font Routines =========---------------------
 ----------------------------------------------------------------------------}
PROCEDURE GetFontMem(VAR Font : FontType);
BEGIN
  Font.Size := (Font.Width*Font.Depth*Font.Height*
               (Font.LastChar-Font.FirstChar+1) + 7) DIV 8;
  GetMem(Font.Data, Font.Size);
END;

PROCEDURE DeleteFont(VAR Font : FontType);
BEGIN
  IF Font.Data <> NIL THEN
  BEGIN
    FreeMem(Font.Data, Font.Size);
    Font.Data := NIL;
  END;
END;

PROCEDURE LoadBIOSFont(VAR Font : FontType; Height : BYTE);
VAR Segm, Offs : WORD;
BEGIN
  IF Font.Data <> NIL THEN
    DeleteFont(Font);         { Release previously used font         }

  Font.Height     := Height;  { Fill out all of the default settings }
  Font.Width      := 8;
  Font.Depth      := 1;
  Font.CharSize   := (Font.Width*Font.Depth*Font.Height+7) SHR 3;
  Font.FirstChar  := 0;
  Font.LastChar   := 255;

  CASE Height OF              { Select the appropriate code.         }
  8  : Height := 3;
  14 : Height := 2;
  16 : Height := 6;
  ELSE EXIT;
  END;

  GetFontMem(Font);           { Allocate memory for the font         }
  ASM
    push BP                   { Save Base Pointer                    }
    mov BH, Height
    mov AX, 1130h             { Function 11h, Subfuntion 30h         } 
    int 10h                   { Interrupt 10h                        }
    mov AX, BP
    pop BP
    mov Offs, AX              { Store the pointer                    }
    mov Segm, ES
  END;
  Move(PTR(Segm, Offs)^, Font.Data^, Font.Size); { Copy the data!    }
END;

PROCEDURE DrawLetter1(Font : FontType; X, Y : INTEGER; C : CHAR; Color : BYTE);
BEGIN
ASM
  mov AL, C                  { Range check }
  cmp AL, Font.LastChar      { IF (C <= Font.LastChar) AND        }
  ja @Exit
  sub AL, Font.FirstChar     {  (C >= Font.FirstChar) THEN        }
  js @Exit                   { Generate ptr to data               }

  mul Font.CharSize          { (C-Font.FirstChar)*Font.CharSize   }
  add AX, WORD [Font.Data]   { OFFSET Font.Data^                  }
  mov SI, AX

  les DI, Screen.Buffer      { Calculate the address of the first }
  add DI, X                  { pixel of the letter.               }
  mov BX, Y
  add BX, BX
  add DI, DS:[BX+OFFSET Screen.YTable]

  mov AL, Color
  mov AH, Font.Background
  mov BX, Screen.Width
  mov CL, Font.Width    { FOR Xc := X TO X+Font.Width-1 DO   }
  mov CH, 0
  sub BX, CX            { BX = Screen.Width-Font.Width }

  mov CH, Font.Height   { FOR Yc := Y TO Y+Font.Height-1 DO  }
  mov DL, 0             { BitsLeft := 0; }

  push DS                    { We must save DS!              }
  mov DS, WORD [Font.Data+2] { DS = Seg(Font.Data^)          }
@Loop:
  or DL, DL
  jnz @GotMoreBits      { IF BitsLeft = 0 THEN               }
  mov DH, DS:[SI]       {   FontData := Font.Data^[FontPtr]; }
  inc SI                {   INC(FontPtr);                    }
  mov DL, 8             {   BitsLeft := 8;                   }
@GotMoreBits:           { END;                               }

  dec DL                { DEC(BitsLeft);                     }
  shl DH, 1             { FontData := FontData SHL 1;        }
  jnc @NoPixel          { IF (FontData AND 128) = 128 THEN   }
  mov ES:[DI], AL       {   SetPixel(Xc, Yc, Color)          }
  jmp @NextLoop

@NoPixel:
  or AH, AH             { ELSE IF (Font.Background > 0) THEN }
  jz @NextLoop
  mov ES:[DI], AH       {   SetPixel(Xc, Yc, Font.Background); }
@NextLoop:
  inc DI
  dec CL
  jnz @Loop

  mov CL, Font.Width     { Reload X counter     }
  add DI, BX             { Move DI to next line }
  dec CH
  jnz @Loop
  pop DS
@Exit:
END;
END;

PROCEDURE WriteG1NC(Font : FontType; X, Y : INTEGER; Text : STRING; Color : BYTE);
VAR
  CurChar : BYTE;                            { Index into Text               }
BEGIN
  FOR CurChar := 1 TO LENGTH(Text) DO        { Step over each char in string }
  BEGIN
    DrawLetter1(Font, X, Y, Text[CurChar], Color);
    INC(X, Font.Width);                              { Step to the right for }
  END;                                               { the next character    }
END;

PROCEDURE DrawLetterFullClip(Font : FontType; X, Y : INTEGER; C : BYTE; Color : BYTE);
VAR
  Yc, BitsLeft, ColorOffs,
  Mask, FontData          : BYTE;
  Xc, FontPtr             : WORD;
BEGIN
  IF (C > Font.LastChar) OR (C < Font.FirstChar) THEN  { Range check   }
    EXIT;

  ASM
    mov AL, $80
    mov CL, Font.Depth
    dec CL
    sar AL, CL
    mov Mask, AL
  END;

  FontPtr := (C-Font.FirstChar)*Font.CharSize;   { Generate ptr to data }
  BitsLeft := 0;
  FOR Yc := Y TO Y+Font.Height-1 DO
    FOR Xc := X TO X+Font.Width-1 DO             { Step over each pixel }
    BEGIN                                        { In the X direction   }
      IF BitsLeft = 0 THEN
      BEGIN
        FontData := Font.Data^[FontPtr];         { Refill FontData when }
        INC(FontPtr);                            { it gets empty        }
        BitsLeft := 8;
      END;

      ColorOffs := (FontData AND Mask) SHR (8-Font.Depth);

      IF (FontData AND 128) = 128 THEN           { Draw a pixel?        }
        SetPixelC(Xc, Yc, Color+ColorOffs-1)
      ELSE IF (Font.Background > 0) THEN         { Draw the background? }
        SetPixelC(Xc, Yc, Font.Background);

      FontData := FontData SHL Font.Depth;
      DEC(BitsLeft, Font.Depth);
    END;
END;

PROCEDURE DrawLetter1HClip(Font : FontType; X, Y : INTEGER; C : CHAR; Color : BYTE);
BEGIN
ASM
  mov AL, C                  { Range check }
  cmp AL, Font.LastChar      { IF (C <= Font.LastChar) AND        }
  ja @Exit
  sub AL, Font.FirstChar     {  (C >= Font.FirstChar) THEN        }
  js @Exit                   { Generate ptr to data               }

  mul Font.CharSize          { (C-Font.FirstChar)*Font.CharSize   }
  add AX, WORD [Font.Data]   { OFFSET Font.Data^                  }
  mov SI, AX

  mov CH, Font.Height   { FOR Yc := Y TO Y+Font.Height-1 DO  }
  mov DL, 0             { BitsLeft := 0; }

  mov AX, Screen.Clip.Y1
  sub AX, Y
  js @NoTopClip
  add Y, AX
  sub CH, AL

  mul Font.Width        { AL = (Y-Screen.Clip.Y1)*Font.Width }
  mov CL, AL
  shr AX, 3
  add SI, AX            { Offset by the number of bytes      }

  and CL, 7             { Now increment individual bits      }
  jz @NoTopClip         { If no pixels are left, then skip bit fiddling }

  mov DL, 8
  mov ES, WORD [Font.Data+2]
  sub DL, CL
  mov DH, ES:[SI]
  inc SI
  shl DH, CL

@NoTopClip:
  mov AX, Y
  add AL, CH
  adc AH, 0                  { AX = Y+Clipped(Font.Height)        }
  sub AX, Screen.Clip.Y2
  dec AL
  js @NoBottomClip
  sub CH, AL                 { Clipped(Height) --                 }

@NoBottomClip:

  les DI, Screen.Buffer      { Calculate the address of the first }
  add DI, X                  { pixel of the letter.               }
  mov BX, Y
  add BX, BX
  add DI, DS:[BX+OFFSET Screen.YTable]

  mov BX, Screen.Width
  mov AL, Font.Width    { FOR Xc := X TO X+Font.Width-1 DO   }
  mov AH, 0
  mov CL, AL
  sub BX, AX            { BX = Screen.Width-Font.Width }

  mov AL, Color
  mov AH, Font.Background

  push DS                    { We must save DS!              }
  mov DS, WORD [Font.Data+2] { DS = Seg(Font.Data^)          }
@Loop:
  or DL, DL
  jnz @GotMoreBits      { IF BitsLeft = 0 THEN               }
  mov DH, DS:[SI]       {   FontData := Font.Data^[FontPtr]; }
  inc SI                {   INC(FontPtr);                    }
  mov DL, 8             {   BitsLeft := 8;                   }
@GotMoreBits:           { END;                               }

  dec DL                { DEC(BitsLeft);                     }
  shl DH, 1             { FontData := FontData SHL 1;        }
  jnc @NoPixel          { IF (FontData AND 128) = 128 THEN   }
  mov ES:[DI], AL       {   SetPixel(Xc, Yc, Color)          }
  jmp @NextLoop

@NoPixel:
  or AH, AH             { ELSE IF (Font.Background > 0) THEN }
  jz @NextLoop
  mov ES:[DI], AH       {   SetPixel(Xc, Yc, Font.Background); }
@NextLoop:
  inc DI
  dec CL
  cmp CL, 0
  jg @Loop

  mov CL, Font.Width     { Reload X counter     }
  add DI, BX             { Move DI to next line }
  dec CH
  cmp CH, 0
  jg @Loop
  pop DS
@Exit:
END;
END;

PROCEDURE WriteG1C(Font : FontType; X, Y : INTEGER; Text : STRING; Color : BYTE);
VAR CurChar : BYTE;                         { Index into Text               }
BEGIN
  IF (X > Screen.Clip.X2) OR (Y > Screen.Clip.Y2) OR
     (X+ORD(Text[0])*Font.Width < Screen.Clip.X1) OR
     (Y+Font.Height < Screen.Clip.Y1) THEN
     EXIT;

  WHILE X+Font.Width*ORD(Text[0])-Font.Width+1 > Screen.Clip.X2 DO
    DEC(Text[0]);

  CurChar := 0;
  WHILE X+Font.Width-1 < Screen.Clip.X1 DO
  BEGIN
    INC(CurChar);
    INC(X, Font.Width);
  END;

  IF X < Screen.Clip.X1 THEN
  BEGIN
    INC(CurChar);
    DrawLetterFullClip(Font, X, Y, ORD(Text[CurChar]), Color);
    INC(X, Font.Width);
  END;

  Move(Text[1+CurChar], Text[1], ORD(Text[0])-CurChar);
  DEC(Text[0], CurChar);

  IF X+Font.Width*ORD(Text[0]) > Screen.Clip.X2 THEN
  BEGIN
    DrawLetterFullClip(Font, X+(ORD(Text[0])-1)*Font.Width, Y,
                       ORD(Text[ORD(Text[0])]), Color);
    DEC(Text[0]);
  END;

  IF (Y < Screen.Clip.Y1) OR (Y+Font.Height > Screen.Clip.Y2) THEN
    FOR CurChar := 1 TO LENGTH(Text) DO     { Step over each char in string }
    BEGIN
      DrawLetter1HClip(Font, X, Y, Text[CurChar], Color);
      INC(X, Font.Width);                           { Step to the right for }
    END                                             { the next character    }
  ELSE
    FOR CurChar := 1 TO LENGTH(Text) DO     { Step over each char in string }
    BEGIN
      DrawLetter1(Font, X, Y, Text[CurChar], Color);
      INC(X, Font.Width);                           { Step to the right for }
    END;                                            { the next character    }
END;

BEGIN
  Screen.DBuffer := FALSE;   { The screen buffer defaults to the real thing }
  Screen.Buffer  := PTR($A000,0);
  Clipping(False);           { Clipping defaults to off }
END.